├── .gitattributes ├── AUTHORS ├── FILES ├── LICENSE ├── README.md ├── TODO ├── cfg ├── BUILDCONFIGSCRIPTS.md ├── config.bat ├── config.samples.txt ├── config.sh └── utils │ ├── CheckMemModel.iso.mod │ └── CheckMemModel.pim.mod ├── m2pp-grammar.gll ├── option-trie-analysis.txt ├── src ├── ArgLexer.def ├── ArgParser.def ├── Args.def ├── BasicFileIO.def ├── BasicFileSys.def ├── BuildParams.def ├── CardMath.def ├── CharArray.def ├── Console.def ├── Dictionary.def ├── Dictionary.mod ├── FNStr.def ├── Hash.def ├── ISO646.def ├── Infile.iso.def ├── Infile.pim.def ├── Newline.def ├── NumStr.def ├── Outfile.iso.def ├── Outfile.pim.def ├── Preprocessor.def ├── Proc.iso.def ├── Proc.pim.def ├── Settings.def ├── Size.cardinal.def ├── Size.longint.def ├── StrBlank.def ├── String.iso.def ├── String.pim.def ├── Tabulator.def ├── Terminal.nonpim.def ├── Terminal.pim.txt ├── dep │ ├── ArgLexer.dep.dot │ ├── ArgParser.dep.dot │ ├── Args.dep.dot │ ├── BasicFileIO.dep.dot │ ├── BasicFileSys.dep.dot │ ├── BuildParams.dep.dot │ ├── CardMath.dep.dot │ ├── CharArray.dep.dot │ ├── Console.dep.dot │ ├── Dictionary.dep.dot │ ├── FNStr.dep.dot │ ├── Hash.dep.dot │ ├── ISO646.dep.dot │ ├── Infile.dep.dot │ ├── M2PP.dep.dot │ ├── Newline.dep.dot │ ├── NumStr.dep.dot │ ├── Outfile.dep.dot │ ├── Preprocessor.dep.dot │ ├── Proc.dep.dot │ ├── Settings.dep.dot │ ├── String.dep.dot │ └── Tabulator.dep.dot ├── imp │ ├── ArgLexer.mod │ ├── ArgParser.mod │ ├── Args.mod │ ├── BasicFileIO │ │ ├── BasicFileIO.gpm.mod │ │ ├── BasicFileIO.iso.mod │ │ ├── BasicFileIO.pim.mod │ │ ├── BasicFileIO.posix.mod │ │ └── BasicFileIO.ulm.mod │ ├── BasicFileSys │ │ ├── BasicFileSys.adw.mod │ │ ├── BasicFileSys.gpm.mod │ │ ├── BasicFileSys.mw.mod │ │ ├── BasicFileSys.p1.mod │ │ ├── BasicFileSys.pim.mod │ │ ├── BasicFileSys.posix.mod │ │ ├── BasicFileSys.ulm.mod │ │ └── BasicFileSys.xds.mod │ ├── CardMath.mod │ ├── CharArray.mod │ ├── Console.mod │ ├── Dictionary.mod │ ├── FNStr.mod │ ├── Hash.mod │ ├── Infile.mod │ ├── M2PP.mod │ ├── Newline.mod │ ├── NumStr.mod │ ├── Outfile.mod │ ├── Preprocessor.mod │ ├── Settings.mod │ ├── StrBlank.mod │ ├── String.iso.mod │ ├── String.pim.mod │ ├── Tabulator.mod │ ├── Terminal.iso.mod │ ├── Terminal.pim.txt │ ├── Terminal.posix.mod │ └── posix │ │ ├── stat.shim.mod │ │ ├── stdio.shim.mod │ │ └── unistd.shim.mod ├── posix │ ├── SysTypes.def │ ├── stat.shim.def │ ├── stat0.ack.def │ ├── stat0.mocka.def │ ├── stdio.gm2.iso.def │ ├── stdio.gm2.pim.def │ ├── stdio.p1.def │ ├── stdio.shim.def │ ├── stdio.xds.def │ ├── stdio0.ack.def │ ├── stdio0.mocka.def │ ├── templates │ │ ├── stdio.gm2.gen.def │ │ ├── stdio0.gen.def │ │ └── unistd0.gen.def │ ├── unistd.gm2.def │ ├── unistd.p1.def │ ├── unistd.shim.def │ ├── unistd.xds.def │ ├── unistd0.ack.def │ └── unistd0.mocka.def └── templates │ ├── BuildInfo.gen.def │ ├── Hash.gen.def │ ├── Infile.gen.def │ └── Outfile.gen.def └── xec ├── LAUNCHSCRIPTS.md ├── m2pp.bat ├── m2pp.com └── m2pp.sh /.gitattributes: -------------------------------------------------------------------------------- 1 | *.def linguist-language=modula-2 2 | *.bat linguist-vendored 3 | *.com linguist-vendored 4 | *.dot linguist-vendored 5 | *.sh linguist-vendored 6 | *.txt linguist-vendored 7 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | Authors: 2 | 3 | * Benjamin Kowarsch 4 | 5 | 6 | Special thanks to: 7 | 8 | * Guenter Dotzel 9 | for providing info how to delete and rename files with ModulaWare Modula-2 10 | 11 | * Rick Sutcliffe 12 | for providing info and examples for interfacing to C API's with p1 Modula-2 13 | 14 | * Fons De Wolf 15 | for providing info how to delete and rename files with ADW Modula-2 16 | 17 | * Gaius Mulley 18 | for adding CSIZE_T and CSSIZE_T to GNU Modula-2's SYSTEM module -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # m2pp 2 | 3 | Modula-2 Preprocessor 4 | 5 | M2PP is a simple preprocessor for the Modula-2 language. 6 | 7 | It generates Modula-2 source files from generic Modula-2 source file templates. Its primary purpose is to provide a means to write and maintain dialect independent code that is portable across different Modula-2 dialects. However, it can also be used for generic programming where the Modula-2 dialect or compiler does not support generics. 8 | 9 | M2PP is itself portable across dialects (PIM3, PIM4, ISO) and compilers (see below). Where necessary, adaptation libraries are provided. Thus far the following compilers are specifically supported: 10 | 11 | * [ACK Modula-2](http://tack.sourceforge.net/olddocs/m2ref.html) 12 | * [ADW (formerly Stony Brook) Modula-2](https://www.modula2.org/adwm2/) 13 | * [GNU Modula-2](http://nongnu.org/gm2/homepage.html) 14 | * [Garden's Point Modula-2](https://github.com/k-john-gough/gpmclr) 15 | * [MOCKA Modula-2](http://www.info.uni-karlsruhe.de/projects.php/id=37&lang=en) 16 | * [Modulaware](https://www.modulaware.com/mwcvms.htm) 17 | * [p1 Modula-2](http://modula2.awiedemann.de/) 18 | * [Ulm's Modula-2 System](http://www.mathematik.uni-ulm.de/modula/) 19 | * [XDS Modula-2](https://www.excelsior-usa.com/xds.html) 20 | 21 | Further, any Modula-2 compiler that supports PIM3/4 and includes modules `FileSystem`, `Storage` and `Terminal` should be able to compile M2PP without problems, for example: 22 | * FST Modula-2 23 | * Logitech Modula-2 24 | * M2F Modula-2 25 | * TERRA Modula-2 26 | 27 | Adaptation libraries for [Aglet Modula-2](http://aglet.web.runbox.net/) and [Clarion (formerly TopSpeed) Modula-2](http://www.softvelocity.com/) are still missing and shall be added later (contributors welcome). 28 | 29 | For more details please visit the project wiki at the URL: 30 | 31 | https://github.com/m2sf/m2pp/wiki 32 | 33 | +++ 34 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | TO DOs 2 | 3 | Scripts 4 | * write launch script for AmigaOS 5 | * write build configuration script for AmigaOS 6 | * write build configuration script for OpenVMS 7 | * complete build configuration script for Windows 8 | 9 | Adaptation Libraries 10 | * implement module BasicFileSys for Aglet Modula-2 11 | * implement module BasicFileSys for Clarion Modula-2 12 | 13 | Missing Functionality 14 | * implement --show-settings output 15 | * implement concat() and comparison() in module String 16 | 17 | [END OF FILE] 18 | -------------------------------------------------------------------------------- /cfg/BUILDCONFIGSCRIPTS.md: -------------------------------------------------------------------------------- 1 | ### Build Configuration Scripts ### 2 | 3 | This directory contains the build configuration scripts for different operating systems: 4 | 5 | * `config.sh` for the bash shell used on Unix and Unix-like operating systems 6 | * `config.bat` for the command interpreter on Windows, MS-DOS and OS/2 7 | * `config.com` for the DCL command language on OpenVMS 8 | 9 | A build configuration script for AmigaOS shall be added in the future. 10 | -------------------------------------------------------------------------------- /cfg/config.samples.txt: -------------------------------------------------------------------------------- 1 | ### GM2 ### 2 | 3 | $ config.sh 4 | *** M2PP build configuration script for Unix/POSIX *** 5 | 6 | Dialect Selection 7 | 1) ISO Modula-2 8 | 2) PIM Modula-2 9 | 3) Quit 10 | Modula-2 dialect: 1 11 | 12 | Compiler Selection 13 | 1) GNU Modula-2 3) p1 Modula-2 5) Quit 14 | 2) GPM Modula-2 4) XDS Modula-2 15 | Modula-2 compiler: 1 16 | 17 | I/O Library Selection 18 | 1) POSIX I/O library 19 | 2) ISO I/O library 20 | 3) Quit 21 | I/O library: 1 22 | 23 | Bitwidths of CARDINAL/LONGINT 24 | 1) 16/16 bits 3) 32/32 bits 5) 64/64 bits 25 | 2) 16/32 bits 4) 32/64 bits 6) Quit 26 | Memory model: 4 27 | 28 | Path of M2PP src directory: ~/Development/m2pp/src 29 | 30 | Selected build configuration 31 | Dialect : ISO Modula-2 (iso) 32 | Compiler : GNU Modula-2 (gm2) 33 | I/O library : POSIX I/O library (posix) 34 | Memory model : 32/64 bits (cardinal) 35 | M2PP src path : /Users/quasimodo/Development/m2pp/src/ 36 | 37 | Are these details correct? (y/n) : y 38 | 39 | Copying source files corresponding to selected build configuration ... 40 | 41 | copying /Users/quasimodo/Development/m2pp/src/Hash.cardinal.def 42 | to /Users/quasimodo/Development/m2pp/src/Hash.def 43 | 44 | copying /Users/quasimodo/Development/m2pp/src/Infile.iso.def 45 | to /Users/quasimodo/Development/m2pp/src/Infile.def 46 | 47 | copying /Users/quasimodo/Development/m2pp/src/Outfile.iso.def 48 | to /Users/quasimodo/Development/m2pp/src/Outfile.def 49 | 50 | copying /Users/quasimodo/Development/m2pp/src/String.iso.def 51 | to /Users/quasimodo/Development/m2pp/src/String.def 52 | 53 | copying /Users/quasimodo/Development/m2pp/src/Terminal.nonpim.def 54 | to /Users/quasimodo/Development/m2pp/src/Terminal.def 55 | 56 | copying /Users/quasimodo/Development/m2pp/src/imp/Terminal.posix.mod 57 | to /Users/quasimodo/Development/m2pp/src/imp/Terminal.mod 58 | 59 | copying /Users/quasimodo/Development/m2pp/src/imp/BasicFileIO/BasicFileIO.posix.mod 60 | to /Users/quasimodo/Development/m2pp/src/imp/BasicFileIO.mod 61 | 62 | copying /Users/quasimodo/Development/m2pp/src/imp/BasicFileSys/BasicFileSys.posix.mod 63 | to /Users/quasimodo/Development/m2pp/src/imp/BasicFileSys.mod 64 | 65 | copying /Users/quasimodo/Development/m2pp/src/posix/stdio.gm2.iso.def 66 | to /Users/quasimodo/Development/m2pp/src/stdio.def 67 | 68 | copying /Users/quasimodo/Development/m2pp/src/posix/unistd.gm2.iso.def 69 | to /Users/quasimodo/Development/m2pp/src/unistd.def 70 | 71 | Build configuration completed. 72 | 73 | ### MOCKA ### 74 | 75 | $ config.sh 76 | *** M2PP build configuration script for Unix/POSIX *** 77 | 78 | Dialect Selection 79 | 1) ISO Modula-2 80 | 2) PIM Modula-2 81 | 3) Quit 82 | Modula-2 dialect: 2 83 | 84 | Compiler Selection 85 | 1) ACK Modula-2 3) MOCKA Modula-2 5) generic PIM compiler 86 | 2) GNU Modula-2 4) Ulm's Modula-2 6) Quit 87 | Modula-2 compiler: 3 88 | 89 | I/O Library Selection 90 | POSIX I/O library 91 | 92 | Bitwidths of CARDINAL/LONGINT 93 | 1) 16/16 bits 3) 32/32 bits 5) 64/64 bits 94 | 2) 16/32 bits 4) 32/64 bits 6) Quit 95 | Memory model: 3 96 | 97 | Path of M2PP src directory: ~/Development/m2pp/src 98 | 99 | Selected build configuration 100 | Dialect : PIM Modula-2 (pim) 101 | Compiler : MOCKA Modula-2 (mocka) 102 | I/O library : POSIX I/O library (posix) 103 | Memory model : 32/32 bits (cardinal) 104 | M2PP src path : /Users/quasimodo/Development/m2pp/src/ 105 | 106 | Are these details correct? (y/n) : y 107 | 108 | Copying source files corresponding to selected build configuration ... 109 | 110 | copying /Users/quasimodo/Development/m2pp/src/Hash.cardinal.def 111 | to /Users/quasimodo/Development/m2pp/src/Hash.def 112 | 113 | copying /Users/quasimodo/Development/m2pp/src/Infile.pim.def 114 | to /Users/quasimodo/Development/m2pp/src/Infile.def 115 | 116 | copying /Users/quasimodo/Development/m2pp/src/Outfile.pim.def 117 | to /Users/quasimodo/Development/m2pp/src/Outfile.def 118 | 119 | copying /Users/quasimodo/Development/m2pp/src/String.pim.def 120 | to /Users/quasimodo/Development/m2pp/src/String.def 121 | 122 | copying /Users/quasimodo/Development/m2pp/src/Terminal.nonpim.def 123 | to /Users/quasimodo/Development/m2pp/src/Terminal.def 124 | 125 | copying /Users/quasimodo/Development/m2pp/src/imp/Terminal.posix.mod 126 | to /Users/quasimodo/Development/m2pp/src/imp/Terminal.mod 127 | 128 | copying /Users/quasimodo/Development/m2pp/src/imp/BasicFileIO/BasicFileIO.posix.mod 129 | to /Users/quasimodo/Development/m2pp/src/imp/BasicFileIO.mod 130 | 131 | copying /Users/quasimodo/Development/m2pp/src/imp/BasicFileSys/BasicFileSys.posix.mod 132 | to /Users/quasimodo/Development/m2pp/src/imp/BasicFileSys.mod 133 | 134 | MOCKA Modula-2 requires POSIX shim libraries 135 | 136 | copying /Users/quasimodo/Development/m2pp/src/posix/stdio.shim.def 137 | to /Users/quasimodo/Development/m2pp/src/stdio.def 138 | 139 | copying /Users/quasimodo/Development/m2pp/src/imp/posix/stdio.shim.mod 140 | to /Users/quasimodo/Development/m2pp/src/imp/stdio.mod 141 | 142 | copying /Users/quasimodo/Development/m2pp/src/posix/unistd.shim.def 143 | to /Users/quasimodo/Development/m2pp/src/unistd.def 144 | 145 | copying /Users/quasimodo/Development/m2pp/src/imp/posix/unistd.shim.mod 146 | to /Users/quasimodo/Development/m2pp/src/imp/unistd.mod 147 | 148 | copying /Users/quasimodo/Development/m2pp/src/posix/stdio0.mocka.def 149 | to /Users/quasimodo/Development/m2pp/src/stdio0.def 150 | 151 | copying /Users/quasimodo/Development/m2pp/src/posix/unistd0.mocka.def 152 | to /Users/quasimodo/Development/m2pp/src/unistd0.def 153 | 154 | Build configuration completed. 155 | 156 | [END OF FILE] -------------------------------------------------------------------------------- /option-trie-analysis.txt: -------------------------------------------------------------------------------- 1 | Option Trie Analysis 2 | 3 | Length=2 4 | 5 | 0 1 6 | -|V 7 | -|h 8 | -|v 9 | --- 10 | 3 0 11 | * 12 | 13 | 14 | Length=6 15 | 16 | 0 1 2 3 4 5 17 | -|-|d|i|c|t 18 | -|-|h|e|l|p 19 | ----------- 20 | 2 2 0 0 0 0 21 | * 22 | 23 | 24 | Length=9 25 | 26 | 0 1 2 3 4 5 6 7 8 27 | -|-|l|i|c|e|n|s|e 28 | -|-|n|e|w|l|i|n|e 29 | -|-|o|u|t|f|i|l|e 30 | -|-|v|e|r|b|o|s|e 31 | -|-|v|e|r|s|i|o|n 32 | ----------------- 33 | 5 5 2 3 2 0 3 2 4 34 | * 35 | 36 | 37 | Length=10 38 | 39 | 0 1 2 3 4 5 6 7 8 9 40 | -|-|t|a|b|w|i|d|t|h 41 | ------------------- 42 | 0 0 0 0 0 0 0 0 0 0 43 | * 44 | 45 | 46 | Length=12 47 | 48 | 0 1 2 3 4 5 6 7 8 9 0 1 49 | -|-|b|u|i|l|d|-|i|n|f|o 50 | ----------------------- 51 | 0 0 0 0 0 0 0 0 0 0 0 0 52 | * 53 | 54 | 55 | Length=15 56 | 57 | 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 58 | -|-|s|h|o|w|-|s|e|t|t|i|n|g|s 59 | ----------------------------- 60 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 61 | * 62 | -------------------------------------------------------------------------------- /src/ArgLexer.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE ArgLexer; 4 | 5 | FROM String IMPORT StringT; (* alias for String.String *) 6 | 7 | 8 | (* --------------------------------------------------------------------------- 9 | * Type Token 10 | * --------------------------------------------------------------------------- 11 | * Enumerated token values representing command line arguments. 12 | * ------------------------------------------------------------------------ *) 13 | 14 | TYPE Token = ( 15 | 16 | (* invalid argument *) 17 | 18 | Invalid, 19 | 20 | (* information options *) 21 | 22 | Help, (* --help, -h *) 23 | Version, (* --version, -V *) 24 | License, (* --license *) 25 | BuildInfo, (* --build-info *) 26 | 27 | (* expansion options *) 28 | 29 | Outfile, (* --outfile *) 30 | Dict, (* --dict *) 31 | TabWidth, (* --tabwidth *) 32 | Newline, (* --newline *) 33 | 34 | (* parameters *) 35 | 36 | FileOrPath, (* filename or pathname *) 37 | Ident, (* identifier *) 38 | Value, (* quoted value *) 39 | Number, (* decimal value *) 40 | 41 | (* punctuation *) 42 | 43 | Equals, (* = *) 44 | 45 | (* diagnostic options *) 46 | 47 | Verbose, (* --verbose, -v *) 48 | ShowSettings, (* --show-settings *) 49 | 50 | (* end of input sentinel *) 51 | 52 | EndOfInput); 53 | 54 | 55 | (* --------------------------------------------------------------------------- 56 | * function nextToken() 57 | * --------------------------------------------------------------------------- 58 | * Reads and consumes the next commmand line argument and returns its token. 59 | * ------------------------------------------------------------------------ *) 60 | 61 | PROCEDURE nextToken () : Token; 62 | 63 | 64 | (* --------------------------------------------------------------------------- 65 | * function lastArg() 66 | * --------------------------------------------------------------------------- 67 | * Returns the argument string of the last consumed argument, or NIL if the 68 | * token returned by a prior call to nextToken() was Equals or EndOfInput, 69 | * or if nextToken() has not been called before. 70 | * ------------------------------------------------------------------------ *) 71 | 72 | PROCEDURE lastArg () : StringT; 73 | 74 | 75 | (* --------------------------------------------------------------------------- 76 | * function isInfoRequest(token) 77 | * --------------------------------------------------------------------------- 78 | * Returns TRUE if token represents an information request, else FALSE. 79 | * ------------------------------------------------------------------------ *) 80 | 81 | PROCEDURE isInfoRequest ( token : Token ) : BOOLEAN; 82 | 83 | 84 | (* --------------------------------------------------------------------------- 85 | * function isExpansionRequest(token) 86 | * --------------------------------------------------------------------------- 87 | * Returns TRUE if token represents a compilation request, else FALSE. 88 | * ------------------------------------------------------------------------ *) 89 | 90 | PROCEDURE isExpansionOption ( token : Token ) : BOOLEAN; 91 | 92 | 93 | (* --------------------------------------------------------------------------- 94 | * function isParameter(token) 95 | * --------------------------------------------------------------------------- 96 | * Returns TRUE if token represents an option parameter, else FALSE. 97 | * ------------------------------------------------------------------------ *) 98 | 99 | PROCEDURE isParameter ( token : Token ) : BOOLEAN; 100 | 101 | 102 | (* --------------------------------------------------------------------------- 103 | * function isDiagnosticOption(token) 104 | * --------------------------------------------------------------------------- 105 | * Returns TRUE if token represents a diagnostic option, else FALSE. 106 | * ------------------------------------------------------------------------ *) 107 | 108 | PROCEDURE isDiagnosticOption ( token : Token ) : BOOLEAN; 109 | 110 | 111 | END ArgLexer. -------------------------------------------------------------------------------- /src/ArgParser.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE ArgParser; 4 | 5 | FROM String IMPORT StringT; (* alias for String.String *) 6 | 7 | 8 | (* Status Type *) 9 | 10 | TYPE Status = ( 11 | Success, 12 | HelpRequested, 13 | VersionRequested, 14 | LicenseRequested, 15 | BuildInfoRequested, 16 | ErrorsEncountered ); 17 | 18 | 19 | (* --------------------------------------------------------------------------- 20 | * function parseArgs() 21 | * --------------------------------------------------------------------------- 22 | * Parses command line arguments and initalises dictionary accordingly. 23 | * ------------------------------------------------------------------------ *) 24 | 25 | PROCEDURE parseArgs () : Status; 26 | 27 | 28 | (* --------------------------------------------------------------------------- 29 | * function errorCount() 30 | * --------------------------------------------------------------------------- 31 | * Returns the count of errors encountered while parsing the arguments. 32 | * ------------------------------------------------------------------------ *) 33 | 34 | PROCEDURE errorCount () : CARDINAL; 35 | 36 | 37 | END ArgParser. -------------------------------------------------------------------------------- /src/Args.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Args; 4 | 5 | (* Program Argument Management *) 6 | 7 | FROM Infile IMPORT InfileT; (* alias for Infile.Infile *) 8 | 9 | 10 | CONST Filename = "m2ppargs.tmp"; 11 | 12 | 13 | PROCEDURE Open; 14 | (* Opens the command line argument file. *) 15 | 16 | 17 | PROCEDURE Close; 18 | (* Closes the command line argument file. *) 19 | 20 | 21 | PROCEDURE Delete; 22 | (* Deletes the command line argument file. *) 23 | 24 | 25 | PROCEDURE Query; 26 | (* Queries program args and writes argument file. *) 27 | 28 | 29 | PROCEDURE file () : InfileT; 30 | (* Returns a file handle to the command line argument file, NIL if closed. *) 31 | 32 | 33 | END Args. -------------------------------------------------------------------------------- /src/BasicFileSys.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE BasicFileSys; 4 | 5 | (* Basic Filesystem Interface for M2PP and M2BSK *) 6 | 7 | FROM Size IMPORT SizeT; 8 | 9 | 10 | TYPE FileSize = SizeT; 11 | 12 | 13 | TYPE Status = ( 14 | Success, (* successful completion *) 15 | FileNotFound, (* attempt to rename or delete a non-existing file *) 16 | FileAlreadyExists, (* attempt to create or rename to an existing file *) 17 | SizeOverflow, (* actual file size overflows type FileSize *) 18 | Failure ); (* any other failure *) 19 | 20 | 21 | PROCEDURE fileExists ( path : ARRAY OF CHAR ) : BOOLEAN; 22 | (* Returns TRUE if the file at the given path exists, else FALSE. *) 23 | 24 | 25 | PROCEDURE GetFileSize 26 | ( path : ARRAY OF CHAR; VAR size : FileSize; VAR status : Status ); 27 | (* Obtains the size of the file at path. On success, the size is passed back 28 | in size and Success is passed back in status. On failure, size remains 29 | unmodified, FileNotFound, SizeOverflow or Failure is passed in status. *) 30 | 31 | 32 | PROCEDURE CreateFile ( path : ARRAY OF CHAR; VAR status : Status ); 33 | (* Creates a new file with the given pathname and passes back status. *) 34 | 35 | 36 | PROCEDURE RenameFile ( path, newPath : ARRAY OF CHAR; VAR status : Status ); 37 | (* Renames the file at path to newPath and passes back status. *) 38 | 39 | 40 | PROCEDURE DeleteFile ( path : ARRAY OF CHAR; VAR status : Status ); 41 | (* Deletes the file at path and passes back status. *) 42 | 43 | 44 | END BasicFileSys. -------------------------------------------------------------------------------- /src/BuildParams.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE BuildParams; 4 | 5 | (* M2PP Build Parameters *) 6 | 7 | CONST 8 | MaxPathLen = 255; 9 | ArgQueryBufferSize = 255; 10 | InfileMaxLineLength = 255; 11 | 12 | END BuildParams. -------------------------------------------------------------------------------- /src/Console.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Console; 4 | 5 | (* Console I/O library *) 6 | 7 | FROM String IMPORT StringT; (* alias for String.String *) 8 | 9 | 10 | (* Read operations *) 11 | 12 | (* --------------------------------------------------------------------------- 13 | * procedure ReadChar(ch) 14 | * --------------------------------------------------------------------------- 15 | * Reads one character from the console and passes it back in ch. 16 | * ------------------------------------------------------------------------ *) 17 | 18 | PROCEDURE ReadChar ( VAR ch : CHAR ); 19 | 20 | 21 | (* --------------------------------------------------------------------------- 22 | * procedure ReadChars(chars) 23 | * --------------------------------------------------------------------------- 24 | * Reads up to HIGH(chars)-1 characters from the console and passes them back 25 | * in chars. NEWLINE terminates input and will not be copied to chars. 26 | * ------------------------------------------------------------------------ *) 27 | 28 | PROCEDURE ReadChars ( VAR chars : ARRAY OF CHAR ); 29 | 30 | 31 | (* Write operations *) 32 | 33 | (* --------------------------------------------------------------------------- 34 | * procedure WriteChar(chars) 35 | * --------------------------------------------------------------------------- 36 | * Prints the given character to the console. 37 | * ------------------------------------------------------------------------ *) 38 | 39 | PROCEDURE WriteChar ( ch : CHAR ); 40 | 41 | 42 | (* --------------------------------------------------------------------------- 43 | * procedure WriteChars(chars) 44 | * --------------------------------------------------------------------------- 45 | * Prints the given character array to the console. Interprets \t and \n. 46 | * ------------------------------------------------------------------------ *) 47 | 48 | PROCEDURE WriteChars ( chars : ARRAY OF CHAR ); 49 | 50 | 51 | (* --------------------------------------------------------------------------- 52 | * procedure WriteString(s) 53 | * --------------------------------------------------------------------------- 54 | * Prints the given string to the console. 55 | * ------------------------------------------------------------------------ *) 56 | 57 | PROCEDURE WriteString ( s : StringT ); 58 | 59 | 60 | (* --------------------------------------------------------------------------- 61 | * procedure WriteCharsAndString(chars, s) 62 | * --------------------------------------------------------------------------- 63 | * Prints the given character array and string to the console. 64 | * ------------------------------------------------------------------------ *) 65 | 66 | PROCEDURE WriteCharsAndString ( VAR chars : ARRAY OF CHAR; s : StringT ); 67 | 68 | 69 | (* --------------------------------------------------------------------------- 70 | * procedure WriteLn 71 | * --------------------------------------------------------------------------- 72 | * Prints newline to the console. 73 | * ------------------------------------------------------------------------ *) 74 | 75 | PROCEDURE WriteLn; 76 | 77 | 78 | (* --------------------------------------------------------------------------- 79 | * procedure WriteBool(value) 80 | * --------------------------------------------------------------------------- 81 | * Prints the given value to the console. "TRUE" for TRUE, "FALSE" for FALSE. 82 | * ------------------------------------------------------------------------ *) 83 | 84 | PROCEDURE WriteBool ( value : BOOLEAN ); 85 | 86 | 87 | (* --------------------------------------------------------------------------- 88 | * procedure WriteCard(value) 89 | * --------------------------------------------------------------------------- 90 | * Prints the given cardinal value to the console. 91 | * ------------------------------------------------------------------------ *) 92 | 93 | PROCEDURE WriteCard ( value : CARDINAL ); 94 | 95 | 96 | (* --------------------------------------------------------------------------- 97 | * procedure WriteInt(value) 98 | * --------------------------------------------------------------------------- 99 | * Prints the given integer value to the console. 100 | * ------------------------------------------------------------------------ *) 101 | 102 | PROCEDURE WriteInt ( value : INTEGER ); 103 | 104 | 105 | END Console. -------------------------------------------------------------------------------- /src/Dictionary.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Dictionary; 4 | 5 | (* Key/Value Dictionary *) 6 | 7 | IMPORT String; 8 | 9 | FROM String IMPORT StringT; (* alias for String.String *) 10 | 11 | 12 | (* Key type *) 13 | 14 | TYPE Key = StringT; 15 | 16 | 17 | (* Value type *) 18 | 19 | TYPE Value = StringT; 20 | 21 | 22 | (* Status type *) 23 | 24 | TYPE Status = 25 | ( Success, 26 | KeyAlreadyPresent, 27 | EntryNotFound, 28 | NilNotPermitted, 29 | AllocationFailed ); 30 | 31 | 32 | (* Procedure type for passing to procedure WithKeyValuePairsDo *) 33 | 34 | TYPE VisitorProc = PROCEDURE ( Key, Value ); 35 | 36 | 37 | (* Invalid key and value sentinels *) 38 | 39 | CONST 40 | NilKey = String.Nil; 41 | NilValue = String.Nil; 42 | 43 | 44 | (* Introspection *) 45 | 46 | (* --------------------------------------------------------------------------- 47 | * function Dictionary.count() 48 | * --------------------------------------------------------------------------- 49 | * Returns the number of key/value pairs in the global dictionary. 50 | * Does not set dictionary status. 51 | * ------------------------------------------------------------------------ *) 52 | 53 | PROCEDURE count ( ) : CARDINAL; 54 | 55 | 56 | (* --------------------------------------------------------------------------- 57 | * function Dictionary.status() 58 | * --------------------------------------------------------------------------- 59 | * Returns the status of the last operation on the global dictionary. 60 | * Does not set dictionary status. 61 | * ------------------------------------------------------------------------ *) 62 | 63 | PROCEDURE status ( ) : Status; 64 | 65 | 66 | (* Lookup Operations *) 67 | 68 | (* --------------------------------------------------------------------------- 69 | * function Dictionary.isPresent(key) 70 | * --------------------------------------------------------------------------- 71 | * Returns TRUE if key is present in the global dictionary, else FALSE. 72 | * Fails and returns NIL if key is NIL. Sets dictionary status. 73 | * ------------------------------------------------------------------------ *) 74 | 75 | PROCEDURE isPresent ( key : Key ) : BOOLEAN; 76 | 77 | 78 | (* --------------------------------------------------------------------------- 79 | * function Dictionary.valueForKey(key) 80 | * --------------------------------------------------------------------------- 81 | * Returns the value stored for key in the global dictionary, or NIL if no key 82 | * is present in the dictionary. Fails if key is NIL. Sets dictionary status. 83 | * ------------------------------------------------------------------------ *) 84 | 85 | PROCEDURE valueForKey ( key : Key ) : Value; 86 | 87 | 88 | (* Insert Operations *) 89 | 90 | (* --------------------------------------------------------------------------- 91 | * procedure Dictionary.StoreValueForKey(key, value) 92 | * --------------------------------------------------------------------------- 93 | * Stores value for key in the global dictionary. Fails if key or value or 94 | * both are NIL. Sets dictionary status. 95 | * ------------------------------------------------------------------------ *) 96 | 97 | PROCEDURE StoreValueForKey ( key : Key; value : Value ); 98 | 99 | 100 | (* --------------------------------------------------------------------------- 101 | * procedure Dictionary.StoreArrayForKey(key, array) 102 | * --------------------------------------------------------------------------- 103 | * Obtains an interned string for array, then stores the string as value for 104 | * key in the global dictionary. Fails if key is NIL or if array produces a 105 | * NIL string. Sets dictionary status. 106 | * ------------------------------------------------------------------------ *) 107 | 108 | PROCEDURE StoreArrayForKey 109 | ( key : Key; VAR (* CONST *) array : ARRAY OF CHAR ); 110 | 111 | 112 | (* Removal Operations *) 113 | 114 | (* --------------------------------------------------------------------------- 115 | * procedure Dictionary.RemoveKey(key) 116 | * --------------------------------------------------------------------------- 117 | * Removes key and its value from the global dictionary. Fails if key is NIL 118 | * or if key is not present in the dictionary. Sets dictionary status. 119 | * ------------------------------------------------------------------------ *) 120 | 121 | PROCEDURE RemoveKey ( key : Key ); 122 | 123 | 124 | (* Iteration *) 125 | 126 | (* --------------------------------------------------------------------------- 127 | * procedure Dictionary.WithKeyValuePairsDo(p) 128 | * --------------------------------------------------------------------------- 129 | * Iterates over all key/value pairs in the global dictionary in key order 130 | * and calls calls visitor procedure p for each pair, passing key and value. 131 | * Keys are ordered in ASCII collation order. Sets dictionary status. 132 | * ------------------------------------------------------------------------ *) 133 | 134 | PROCEDURE WithKeyValuePairsDo ( p : VisitorProc ); 135 | 136 | 137 | END Dictionary. -------------------------------------------------------------------------------- /src/FNStr.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE FNStr; 4 | 5 | (* Filename string operations *) 6 | 7 | FROM String IMPORT StringT; (* alias for String.String *) 8 | 9 | 10 | CONST 11 | MaxBackupVersionLimit = 32; 12 | DefaultBackupVersionLimit = 3; 13 | 14 | 15 | TYPE BackupVersionRange = CARDINAL [0..MaxBackupVersionLimit]; 16 | 17 | 18 | (* --------------------------------------------------------------------------- 19 | * function FNStr.targetName(source) 20 | * --------------------------------------------------------------------------- 21 | * Returns a target pathname for a given source pathname. The target path is 22 | * derived from the source path as follows. (1) If the source path does not 23 | * contain any extension, '.out' is appended to it. Otherwise, (2a) if its 24 | * extension is '.gen', the extension is replaced with '.out'; or (2b) if 25 | * its extension is preceded by '.gen', then the '.gen' part is removed. 26 | * (3) In any other case '.out' is inserted before the extension. 27 | * 28 | * Examples: 29 | * 30 | * case | source string | returned string 31 | * -----+-------------------+------------------ 32 | * (1) | FooBarBaz | FooBarBaz.out 33 | * (2a) | FooBarBaz.gen | FooBarBaz.out 34 | * (2b) | FooBarBaz.gen.def | FooBarBaz.def 35 | * (3) | FooBarBaz.def | FooBarBaz.out.def 36 | * ------------------------------------------------------------------------ *) 37 | 38 | PROCEDURE targetName ( sourceName : StringT ) : StringT; 39 | 40 | 41 | (* --------------------------------------------------------------------------- 42 | * function FNStr.backupName(source) 43 | * --------------------------------------------------------------------------- 44 | * Returns a backup pathname for a given original pathname. The backup path is 45 | * derived from the original path by appending extension '.BAK'. If a backup 46 | * file with the same name already exists, then a version suffix is appended. 47 | * A version suffix consists of ';' followed by a non-negative integer number 48 | * starting at 1. For each new version suffixed name, the version number is 49 | * increased by 1. A Nil string is returned if the version limit is reached. 50 | * 51 | * Examples: 52 | * 53 | * original string | returned backup string 54 | * --------------------+----------------------- 55 | * FooBarBaz.def | FooBarBaz.def.BAK 56 | * FooBarBaz.def.BAK | FooBarBaz.def.BAK;1 57 | * FooBarBaz.def.BAK;1 | FooBarBaz.def.BAK;2 58 | * FooBarBaz.def.BAK;2 | FooBarBaz.def.BAK;3 59 | * ------------------------------------------------------------------------ *) 60 | 61 | PROCEDURE backupName ( origName : StringT ) : StringT; 62 | 63 | 64 | (* --------------------------------------------------------------------------- 65 | * procedure FNStr.SetBackupVersionLimit(value) 66 | * --------------------------------------------------------------------------- 67 | * Sets the version limit for version suffixing by function backupName(). 68 | * ------------------------------------------------------------------------ *) 69 | 70 | PROCEDURE SetBackupVersionLimit ( value : BackupVersionRange ); 71 | 72 | 73 | (* --------------------------------------------------------------------------- 74 | * function FNStr.backupVersionLimit() 75 | * --------------------------------------------------------------------------- 76 | * Returns the version limit for version suffixing by function backupName(). 77 | * ------------------------------------------------------------------------ *) 78 | 79 | PROCEDURE backupVersionLimit () : CARDINAL; 80 | 81 | 82 | END FNStr. -------------------------------------------------------------------------------- /src/Hash.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Hash; 4 | 5 | (* General Purpose Hash Function *) 6 | 7 | 8 | TYPE Key; (* OPAQUE *) 9 | 10 | 11 | CONST MaxBits = 32; (* upper limit for hash values *) 12 | 13 | 14 | (* --------------------------------------------------------------------------- 15 | * function Hash.initialValue() 16 | * --------------------------------------------------------------------------- 17 | * Returns the initial hash value for incremental hash calculation. 18 | * ------------------------------------------------------------------------ *) 19 | 20 | PROCEDURE initialValue () : Key; 21 | 22 | 23 | (* --------------------------------------------------------------------------- 24 | * function Hash.valueForNextChar(hash, ch) 25 | * --------------------------------------------------------------------------- 26 | * Returns the next incremental value for incremental hash calculation. 27 | * ------------------------------------------------------------------------ *) 28 | 29 | PROCEDURE valueForNextChar ( hash : Key; ch : CHAR ) : Key; 30 | 31 | 32 | (* --------------------------------------------------------------------------- 33 | * function Hash.finalValue( hash ) 34 | * --------------------------------------------------------------------------- 35 | * Returns the final hash value for incremental hash calculation. 36 | * ------------------------------------------------------------------------ *) 37 | 38 | PROCEDURE finalValue ( hash : Key ) : Key; 39 | 40 | 41 | (* --------------------------------------------------------------------------- 42 | * function Hash.valueForArray( array ) 43 | * --------------------------------------------------------------------------- 44 | * Returns the hash value for the given character array. 45 | * ------------------------------------------------------------------------ *) 46 | 47 | PROCEDURE valueForArray ( VAR (*CONST*) array : ARRAY OF CHAR ) : Key; 48 | 49 | 50 | (* --------------------------------------------------------------------------- 51 | * function Hash.valueForArraySlice( array, start, end ) 52 | * --------------------------------------------------------------------------- 53 | * Returns the hash value for the given character array slice. 54 | * ------------------------------------------------------------------------ *) 55 | 56 | PROCEDURE valueForArraySlice 57 | ( VAR (*CONST*) array : ARRAY OF CHAR; start, end : CARDINAL ) : Key; 58 | 59 | 60 | (* --------------------------------------------------------------------------- 61 | * function Hash.mod( hash, n ) 62 | * --------------------------------------------------------------------------- 63 | * Returns the CARDINAL value of hash MOD n for n IN [1..MAX(CARDINAL)]. 64 | * ------------------------------------------------------------------------ *) 65 | 66 | TYPE NatCard = CARDINAL [1..MAX(CARDINAL)]; 67 | 68 | PROCEDURE mod ( hash : Key; n : NatCard ) : CARDINAL; 69 | 70 | 71 | END Hash. -------------------------------------------------------------------------------- /src/ISO646.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE ISO646; 4 | 5 | (* Mnemonics for 7-bit ISO-646 code points *) 6 | 7 | 8 | (* Control Codes *) 9 | 10 | CONST 11 | NUL = CHR(0); (* 0u0 *) 12 | SOH = CHR(1); (* 0u01 *) 13 | STX = CHR(2); (* 0u02 *) 14 | ETX = CHR(3); (* 0u03 *) 15 | EOT = CHR(4); (* 0u04 *) 16 | ENQ = CHR(5); (* 0u05 *) 17 | ACK = CHR(6); (* 0u06 *) 18 | BEL = CHR(7); (* 0u07 *) 19 | BS = CHR(8); (* 0u08 *) 20 | HT = CHR(9); (* 0u09 *) 21 | LF = CHR(10); (* 0u0A *) 22 | VT = CHR(11); (* 0u0B *) 23 | FF = CHR(12); (* 0u0C *) 24 | CR = CHR(13); (* 0u0D *) 25 | SO = CHR(14); (* 0u0E *) 26 | SI = CHR(15); (* 0u0F *) 27 | DLE = CHR(16); (* 0u10 *) 28 | DC1 = CHR(17); (* 0u11 *) 29 | DC2 = CHR(18); (* 0u12 *) 30 | DC3 = CHR(19); (* 0u13 *) 31 | DC4 = CHR(20); (* 0u14 *) 32 | NAK = CHR(21); (* 0u15 *) 33 | SYN = CHR(22); (* 0u16 *) 34 | ETB = CHR(23); (* 0u17 *) 35 | CAN = CHR(24); (* 0u18 *) 36 | EM = CHR(25); (* 0u19 *) 37 | SUB = CHR(26); (* 0u1A *) 38 | ESC = CHR(27); (* 0u1B *) 39 | FS = CHR(28); (* 0u1C *) 40 | GS = CHR(29); (* 0u1D *) 41 | RS = CHR(30); (* 0u1E *) 42 | US = CHR(31); (* 0u1F *) 43 | DEL = CHR(127); (* 0u7F *) 44 | 45 | 46 | (* Whitespace *) 47 | 48 | SP = CHR(32); (* 0u20 *) 49 | 50 | 51 | (* Non-Alphanumeric *) 52 | 53 | EXCLAMATION = CHR(33); (* ! *) 54 | DOUBLEQUOTE = CHR(34); (* " *) 55 | OCTOTHORPE = CHR(35); (* # *) 56 | DOLLAR = CHR(36); (*_$_*) 57 | PERCENT = CHR(37); (* % *) 58 | AMPERSAND = CHR(38); (* & *) 59 | SINGLEQUOTE = CHR(39); (* ' *) 60 | LEFTPAREN = CHR(40); (* ( *) 61 | RIGHTPAREN = CHR(41); (* ) *) 62 | ASTERISK = CHR(42); (* * *) 63 | PLUS = CHR(43); (* + *) 64 | COMMA = CHR(44); (* , *) 65 | MINUS = CHR(45); (* - *) 66 | FULLSTOP = CHR(46); (* . *) 67 | SOLIDUS = CHR(47); (* / *) 68 | COLON = CHR(58); (* : *) 69 | SEMICOLON = CHR(59); (* ; *) 70 | LESS = CHR(60); (* < *) 71 | EQUAL = CHR(61); (* = *) 72 | GREATER = CHR(62); (* > *) 73 | QUESTIONMARK = CHR(63); (* ? *) 74 | ATSIGN = CHR(64); (* @ *) 75 | LEFTBRACKET = CHR(91); (* [ *) 76 | BACKSLASH = CHR(92); (* \ *) 77 | RIGHTBRACKET = CHR(93); (* ] *) 78 | CARET = CHR(94); (* ^ *) 79 | LOWLINE = CHR(95); (* _ *) 80 | BACKQUOTE = CHR(96); (* ` *) 81 | LEFTBRACE = CHR(123); (* { *) 82 | VERTICALBAR = CHR(124); (* | *) 83 | RIGHTBRACE = CHR(125); (* } *) 84 | TILDE = CHR(126); (* ~ *) 85 | 86 | 87 | (* Aliases *) 88 | 89 | NEWLINE = LF; 90 | TAB = HT; 91 | TABULATOR = HT; 92 | SPACE = SP; 93 | APOSTROPHE = SINGLEQUOTE; 94 | PERIOD = FULLSTOP; 95 | SLASH = SOLIDUS; 96 | EQUALS = EQUAL; 97 | LPAREN = LEFTPAREN; 98 | RPAREN = RIGHTPAREN; 99 | LBRACKET = LEFTBRACKET; 100 | RBRACKET = RIGHTBRACKET; 101 | LBRACE = LEFTBRACE; 102 | RBRACE = RIGHTBRACE; 103 | 104 | 105 | END ISO646. -------------------------------------------------------------------------------- /src/Infile.iso.def: -------------------------------------------------------------------------------- 1 | (*!m2iso*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Infile; (* ISO version *) 4 | 5 | (* I/O library for reading text files with line and column counters *) 6 | 7 | IMPORT SYSTEM, BuildParams, BasicFileIO; 8 | 9 | FROM String IMPORT StringT; (* alias for String.String *) 10 | 11 | 12 | (* --------------------------------------------------------------------------- 13 | * Maximum line length 14 | * ------------------------------------------------------------------------ *) 15 | 16 | CONST MaxLineLength = BuildParams.InfileMaxLineLength; 17 | 18 | 19 | (* --------------------------------------------------------------------------- 20 | * File type for reading 21 | * ------------------------------------------------------------------------ *) 22 | 23 | TYPE Infile; (* OPAQUE *) 24 | 25 | TYPE InfileT = Infile; (* for unqualified use *) 26 | 27 | 28 | (* --------------------------------------------------------------------------- 29 | * Invalid file sentinel 30 | * ------------------------------------------------------------------------ *) 31 | 32 | CONST Nil = SYSTEM.CAST(Infile, NIL); (* ISO specific *) 33 | 34 | 35 | (* --------------------------------------------------------------------------- 36 | * procedure Open(infile, path, status ) 37 | * --------------------------------------------------------------------------- 38 | * Opens the file at path and passes a newly allocated and initialised infile 39 | * object back in out-parameter infile. Passes Infile.Nil on failure. 40 | * ------------------------------------------------------------------------ *) 41 | 42 | PROCEDURE Open 43 | ( VAR (* NEW *) infile : Infile; 44 | VAR (* CONST *) path : ARRAY OF CHAR; 45 | VAR status : BasicFileIO.Status ); 46 | 47 | 48 | (* --------------------------------------------------------------------------- 49 | * procedure Close(infile) 50 | * --------------------------------------------------------------------------- 51 | * Closes the file associated with infile and passes Infile.Nil in infile. 52 | * ------------------------------------------------------------------------ *) 53 | 54 | PROCEDURE Close ( VAR infile : Infile ); 55 | 56 | 57 | (* --------------------------------------------------------------------------- 58 | * function consumeChar(infile) 59 | * --------------------------------------------------------------------------- 60 | * Consumes the current lookahead character in infile. Returns the resulting 61 | * new lookahead character without consuming it. 62 | * ------------------------------------------------------------------------ *) 63 | 64 | PROCEDURE consumeChar ( infile : Infile ) : CHAR; 65 | 66 | 67 | (* --------------------------------------------------------------------------- 68 | * function lookaheadChar(infile) 69 | * --------------------------------------------------------------------------- 70 | * Returns the current lookahead char in infile without consuming any char. 71 | * ------------------------------------------------------------------------ *) 72 | 73 | PROCEDURE lookaheadChar ( infile : Infile ) : CHAR; 74 | 75 | 76 | (* --------------------------------------------------------------------------- 77 | * function la2Char(infile) 78 | * --------------------------------------------------------------------------- 79 | * Returns the 2nd lookahead char in infile without consuming any character. 80 | * ------------------------------------------------------------------------ *) 81 | 82 | PROCEDURE la2Char ( infile : Infile ) : CHAR; 83 | 84 | 85 | (* --------------------------------------------------------------------------- 86 | * function status() 87 | * --------------------------------------------------------------------------- 88 | * Returns status of last operation. 89 | * ------------------------------------------------------------------------ *) 90 | 91 | PROCEDURE status ( infile : Infile ) : BasicFileIO.Status; 92 | 93 | 94 | (* --------------------------------------------------------------------------- 95 | * function eof() 96 | * --------------------------------------------------------------------------- 97 | * Returns TRUE if infile has reached the end of the file, else FALSE. 98 | * ------------------------------------------------------------------------ *) 99 | 100 | PROCEDURE eof( infile : Infile ) : BOOLEAN; 101 | 102 | 103 | (* --------------------------------------------------------------------------- 104 | * function line(infile) 105 | * --------------------------------------------------------------------------- 106 | * Returns the line number of the current reading position of infile. 107 | * ------------------------------------------------------------------------ *) 108 | 109 | PROCEDURE line ( infile : Infile ) : CARDINAL; 110 | 111 | 112 | (* --------------------------------------------------------------------------- 113 | * function column(infile) 114 | * --------------------------------------------------------------------------- 115 | * Returns the column number of the current reading position of infile. 116 | * ------------------------------------------------------------------------ *) 117 | 118 | PROCEDURE column ( infile : Infile ) : CARDINAL; 119 | 120 | 121 | (* --------------------------------------------------------------------------- 122 | * procedure MarkLexeme(infile) 123 | * --------------------------------------------------------------------------- 124 | * Marks the current lookahead character as the start of a lexeme. 125 | * ------------------------------------------------------------------------ *) 126 | 127 | PROCEDURE MarkLexeme( infile : Infile ); 128 | 129 | 130 | (* --------------------------------------------------------------------------- 131 | * function lexeme(infile ch) 132 | * --------------------------------------------------------------------------- 133 | * Returns the current lexeme. Returns NIL if no lexeme has been marked, or 134 | * if no characters have been consumed since MarkLexeme() has been called. 135 | * ------------------------------------------------------------------------ *) 136 | 137 | PROCEDURE lexeme ( infile : Infile ) : StringT; 138 | 139 | 140 | END Infile. 141 | -------------------------------------------------------------------------------- /src/Infile.pim.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Infile; (* PIM version *) 4 | 5 | (* I/O library for reading text files with line and column counters *) 6 | 7 | IMPORT SYSTEM, BuildParams, BasicFileIO; 8 | 9 | FROM String IMPORT StringT; (* alias for String.String *) 10 | 11 | 12 | (* --------------------------------------------------------------------------- 13 | * Maximum line length 14 | * ------------------------------------------------------------------------ *) 15 | 16 | CONST MaxLineLength = BuildParams.InfileMaxLineLength; 17 | 18 | 19 | (* --------------------------------------------------------------------------- 20 | * File type for reading 21 | * ------------------------------------------------------------------------ *) 22 | 23 | TYPE Infile; (* OPAQUE *) 24 | 25 | TYPE InfileT = Infile; (* for unqualified use *) 26 | 27 | 28 | (* --------------------------------------------------------------------------- 29 | * Invalid file sentinel 30 | * ------------------------------------------------------------------------ *) 31 | 32 | CONST Nil = Infile(NIL); (* PIM specific *) 33 | 34 | 35 | (* --------------------------------------------------------------------------- 36 | * procedure Open(infile, path, status ) 37 | * --------------------------------------------------------------------------- 38 | * Opens the file at path and passes a newly allocated and initialised infile 39 | * object back in out-parameter infile. Passes Infile.Nil on failure. 40 | * ------------------------------------------------------------------------ *) 41 | 42 | PROCEDURE Open 43 | ( VAR (* NEW *) infile : Infile; 44 | VAR (* CONST *) path : ARRAY OF CHAR; 45 | VAR status : BasicFileIO.Status ); 46 | 47 | 48 | (* --------------------------------------------------------------------------- 49 | * procedure Close(infile) 50 | * --------------------------------------------------------------------------- 51 | * Closes the file associated with infile and passes Infile.Nil in infile. 52 | * ------------------------------------------------------------------------ *) 53 | 54 | PROCEDURE Close ( VAR infile : Infile ); 55 | 56 | 57 | (* --------------------------------------------------------------------------- 58 | * function consumeChar(infile) 59 | * --------------------------------------------------------------------------- 60 | * Consumes the current lookahead character in infile. Returns the resulting 61 | * new lookahead character without consuming it. 62 | * ------------------------------------------------------------------------ *) 63 | 64 | PROCEDURE consumeChar ( infile : Infile ) : CHAR; 65 | 66 | 67 | (* --------------------------------------------------------------------------- 68 | * function lookaheadChar(infile) 69 | * --------------------------------------------------------------------------- 70 | * Returns the current lookahead char in infile without consuming any char. 71 | * ------------------------------------------------------------------------ *) 72 | 73 | PROCEDURE lookaheadChar ( infile : Infile ) : CHAR; 74 | 75 | 76 | (* --------------------------------------------------------------------------- 77 | * function la2Char(infile) 78 | * --------------------------------------------------------------------------- 79 | * Returns the 2nd lookahead char in infile without consuming any character. 80 | * ------------------------------------------------------------------------ *) 81 | 82 | PROCEDURE la2Char ( infile : Infile ) : CHAR; 83 | 84 | 85 | (* --------------------------------------------------------------------------- 86 | * function status() 87 | * --------------------------------------------------------------------------- 88 | * Returns status of last operation. 89 | * ------------------------------------------------------------------------ *) 90 | 91 | PROCEDURE status ( infile : Infile ) : BasicFileIO.Status; 92 | 93 | 94 | (* --------------------------------------------------------------------------- 95 | * function eof() 96 | * --------------------------------------------------------------------------- 97 | * Returns TRUE if infile has reached the end of the file, else FALSE. 98 | * ------------------------------------------------------------------------ *) 99 | 100 | PROCEDURE eof( infile : Infile ) : BOOLEAN; 101 | 102 | 103 | (* --------------------------------------------------------------------------- 104 | * function line(infile) 105 | * --------------------------------------------------------------------------- 106 | * Returns the line number of the current reading position of infile. 107 | * ------------------------------------------------------------------------ *) 108 | 109 | PROCEDURE line ( infile : Infile ) : CARDINAL; 110 | 111 | 112 | (* --------------------------------------------------------------------------- 113 | * function column(infile) 114 | * --------------------------------------------------------------------------- 115 | * Returns the column number of the current reading position of infile. 116 | * ------------------------------------------------------------------------ *) 117 | 118 | PROCEDURE column ( infile : Infile ) : CARDINAL; 119 | 120 | 121 | (* --------------------------------------------------------------------------- 122 | * procedure MarkLexeme(infile) 123 | * --------------------------------------------------------------------------- 124 | * Marks the current lookahead character as the start of a lexeme. 125 | * ------------------------------------------------------------------------ *) 126 | 127 | PROCEDURE MarkLexeme( infile : Infile ); 128 | 129 | 130 | (* --------------------------------------------------------------------------- 131 | * function lexeme(infile ch) 132 | * --------------------------------------------------------------------------- 133 | * Returns the current lexeme. Returns NIL if no lexeme has been marked, or 134 | * if no characters have been consumed since MarkLexeme() has been called. 135 | * ------------------------------------------------------------------------ *) 136 | 137 | PROCEDURE lexeme ( infile : Infile ) : StringT; 138 | 139 | 140 | END Infile. 141 | -------------------------------------------------------------------------------- /src/Newline.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Newline; 4 | 5 | (* Newline mode management *) 6 | 7 | TYPE Mode = ( LF, CR, CRLF ); 8 | 9 | CONST Default = LF; 10 | 11 | 12 | PROCEDURE SetMode ( mode : Mode ); 13 | (* Sets the newline mode. *) 14 | 15 | 16 | PROCEDURE mode ( ) : Mode; 17 | (* Returns the newline mode. *) 18 | 19 | 20 | END Newline. -------------------------------------------------------------------------------- /src/NumStr.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE NumStr; 4 | 5 | (* Numeric String Conversion Library *) 6 | 7 | FROM String IMPORT StringT; (* alias for String.String *) 8 | 9 | 10 | TYPE Status = ( Success, Underflow, Overflow, NaN ); 11 | 12 | 13 | PROCEDURE ToCard 14 | ( numStr : StringT; VAR value : CARDINAL; VAR status : Status ); 15 | (* Converts the value represented by numStr to type CARDINAL. *) 16 | 17 | 18 | PROCEDURE ToInt 19 | ( numStr : StringT; VAR value : INTEGER; VAR status : Status ); 20 | (* Converts the value represented by numStr to type INTEGER. *) 21 | 22 | 23 | END NumStr. -------------------------------------------------------------------------------- /src/Outfile.iso.def: -------------------------------------------------------------------------------- 1 | (*!m2iso*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Outfile; (* ISO version *) 4 | 5 | (* I/O library for writing text files with tab expansion *) 6 | 7 | IMPORT SYSTEM, BasicFileIO, Newline; 8 | 9 | FROM String IMPORT StringT; (* alias for String.String *) 10 | 11 | 12 | (* --------------------------------------------------------------------------- 13 | * File type for reading 14 | * ------------------------------------------------------------------------ *) 15 | 16 | TYPE Outfile; (* OPAQUE *) 17 | 18 | TYPE OutfileT = Outfile; (* for unqualified use *) 19 | 20 | 21 | (* --------------------------------------------------------------------------- 22 | * Invalid file sentinel 23 | * ------------------------------------------------------------------------ *) 24 | 25 | CONST Nil = SYSTEM.CAST(Outfile, NIL); (* ISO specific *) 26 | 27 | 28 | (* --------------------------------------------------------------------------- 29 | * procedure Open(outfile, path, status ) 30 | * --------------------------------------------------------------------------- 31 | * Opens the file at path and passes a newly allocated and initialised outfile 32 | * object back in out-parameter outfile. Passes NilOutfile on failure. 33 | * ------------------------------------------------------------------------ *) 34 | 35 | PROCEDURE Open 36 | ( VAR (* NEW *) outfile : Outfile; 37 | VAR (* CONST *) path : ARRAY OF CHAR; 38 | VAR status : BasicFileIO.Status ); 39 | 40 | 41 | (* --------------------------------------------------------------------------- 42 | * procedure Close(outfile) 43 | * --------------------------------------------------------------------------- 44 | * Closes the file associated with outfile and passes NilOutfile in outfile. 45 | * ------------------------------------------------------------------------ *) 46 | 47 | PROCEDURE Close ( VAR outfile : Outfile ); 48 | 49 | 50 | (* --------------------------------------------------------------------------- 51 | * procedure SetTabWidth(outfile, value) 52 | * --------------------------------------------------------------------------- 53 | * Sets the tab width for outfile. The default value is two. 54 | * Operation only permitted prior to first write operation to outfile. 55 | * ------------------------------------------------------------------------ *) 56 | 57 | TYPE TabWidth = CARDINAL [0..8]; 58 | 59 | PROCEDURE SetTabWidth ( outfile : Outfile; value : TabWidth ); 60 | 61 | 62 | (* --------------------------------------------------------------------------- 63 | * procedure SetNewlineMode(outfile, mode) 64 | * --------------------------------------------------------------------------- 65 | * Sets the newline mode for outfile. The default is Newline.mode(). 66 | * Operation only permitted prior to first write operation to outfile. 67 | * ------------------------------------------------------------------------ *) 68 | 69 | PROCEDURE SetNewlineMode ( outfile : Outfile; mode : Newline.Mode ); 70 | 71 | 72 | (* --------------------------------------------------------------------------- 73 | * procedure WriteChar(outfile, ch) 74 | * --------------------------------------------------------------------------- 75 | * Writes character ch to outfile. 76 | * ------------------------------------------------------------------------ *) 77 | 78 | PROCEDURE WriteChar ( outfile : Outfile; ch : CHAR ); 79 | 80 | 81 | (* --------------------------------------------------------------------------- 82 | * procedure WriteChars(outfile, array) 83 | * --------------------------------------------------------------------------- 84 | * Writes characters in array to outfile. 85 | * ------------------------------------------------------------------------ *) 86 | 87 | PROCEDURE WriteChars 88 | ( outfile : Outfile; VAR (* CONST *) array : ARRAY OF CHAR ); 89 | 90 | 91 | (* --------------------------------------------------------------------------- 92 | * procedure WriteString(outfile, string) 93 | * --------------------------------------------------------------------------- 94 | * Writes string to outfile. 95 | * ------------------------------------------------------------------------ *) 96 | 97 | PROCEDURE WriteString ( outfile : Outfile; string : StringT ); 98 | 99 | 100 | (* --------------------------------------------------------------------------- 101 | * procedure WriteTab(outfile) 102 | * --------------------------------------------------------------------------- 103 | * Writes tab to outfile. Expands tabs to spaces if tabwidth > 0. 104 | * ------------------------------------------------------------------------ *) 105 | 106 | PROCEDURE WriteTab ( outfile : Outfile ); 107 | 108 | 109 | (* --------------------------------------------------------------------------- 110 | * procedure WriteLn(outfile) 111 | * --------------------------------------------------------------------------- 112 | * Writes newline to outfile. 113 | * ------------------------------------------------------------------------ *) 114 | 115 | PROCEDURE WriteLn ( outfile : Outfile ); 116 | 117 | 118 | (* --------------------------------------------------------------------------- 119 | * function status(outfile) 120 | * --------------------------------------------------------------------------- 121 | * Returns status of last operation. 122 | * ------------------------------------------------------------------------ *) 123 | 124 | PROCEDURE status ( outfile : Outfile ) : BasicFileIO.Status; 125 | 126 | 127 | (* --------------------------------------------------------------------------- 128 | * procedure line(outfile) 129 | * --------------------------------------------------------------------------- 130 | * Returns the line number of the current writing position of outfile. 131 | * ------------------------------------------------------------------------ *) 132 | 133 | PROCEDURE line ( outfile : Outfile ) : CARDINAL; 134 | 135 | 136 | (* --------------------------------------------------------------------------- 137 | * procedure column(outfile) 138 | * --------------------------------------------------------------------------- 139 | * Returns the column number of the current writing position of outfile. 140 | * ------------------------------------------------------------------------ *) 141 | 142 | PROCEDURE column ( outfile : Outfile ) : CARDINAL; 143 | 144 | 145 | END Outfile. -------------------------------------------------------------------------------- /src/Outfile.pim.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Outfile; (* PIM version *) 4 | 5 | (* I/O library for writing text files with tab expansion *) 6 | 7 | IMPORT SYSTEM, BasicFileIO, Newline; 8 | 9 | FROM String IMPORT StringT; (* alias for String.String *) 10 | 11 | 12 | (* --------------------------------------------------------------------------- 13 | * File type for reading 14 | * ------------------------------------------------------------------------ *) 15 | 16 | TYPE Outfile; (* OPAQUE *) 17 | 18 | TYPE OutfileT = Outfile; (* for unqualified use *) 19 | 20 | 21 | (* --------------------------------------------------------------------------- 22 | * Invalid file sentinel 23 | * ------------------------------------------------------------------------ *) 24 | 25 | CONST Nil = Outfile(NIL); (* PIM specific *) 26 | 27 | 28 | (* --------------------------------------------------------------------------- 29 | * procedure Open(outfile, path, status ) 30 | * --------------------------------------------------------------------------- 31 | * Opens the file at path and passes a newly allocated and initialised outfile 32 | * object back in out-parameter outfile. Passes NilOutfile on failure. 33 | * ------------------------------------------------------------------------ *) 34 | 35 | PROCEDURE Open 36 | ( VAR (* NEW *) outfile : Outfile; 37 | VAR (* CONST *) path : ARRAY OF CHAR; 38 | VAR status : BasicFileIO.Status ); 39 | 40 | 41 | (* --------------------------------------------------------------------------- 42 | * procedure Close(outfile) 43 | * --------------------------------------------------------------------------- 44 | * Closes the file associated with outfile and passes NilOutfile in outfile. 45 | * ------------------------------------------------------------------------ *) 46 | 47 | PROCEDURE Close ( VAR outfile : Outfile ); 48 | 49 | 50 | (* --------------------------------------------------------------------------- 51 | * procedure SetTabWidth(outfile, value) 52 | * --------------------------------------------------------------------------- 53 | * Sets the tab width for outfile. The default value is two. 54 | * Operation only permitted prior to first write operation to outfile. 55 | * ------------------------------------------------------------------------ *) 56 | 57 | TYPE TabWidth = CARDINAL [0..8]; 58 | 59 | PROCEDURE SetTabWidth ( outfile : Outfile; value : TabWidth ); 60 | 61 | 62 | (* --------------------------------------------------------------------------- 63 | * procedure SetNewlineMode(outfile, mode) 64 | * --------------------------------------------------------------------------- 65 | * Sets the newline mode for outfile. The default is Newline.mode(). 66 | * Operation only permitted prior to first write operation to outfile. 67 | * ------------------------------------------------------------------------ *) 68 | 69 | PROCEDURE SetNewlineMode ( outfile : Outfile; mode : Newline.Mode ); 70 | 71 | 72 | (* --------------------------------------------------------------------------- 73 | * procedure WriteChar(outfile, ch) 74 | * --------------------------------------------------------------------------- 75 | * Writes character ch to outfile. 76 | * ------------------------------------------------------------------------ *) 77 | 78 | PROCEDURE WriteChar ( outfile : Outfile; ch : CHAR ); 79 | 80 | 81 | (* --------------------------------------------------------------------------- 82 | * procedure WriteChars(outfile, array) 83 | * --------------------------------------------------------------------------- 84 | * Writes characters in array to outfile. 85 | * ------------------------------------------------------------------------ *) 86 | 87 | PROCEDURE WriteChars 88 | ( outfile : Outfile; VAR (* CONST *) array : ARRAY OF CHAR ); 89 | 90 | 91 | (* --------------------------------------------------------------------------- 92 | * procedure WriteString(outfile, string) 93 | * --------------------------------------------------------------------------- 94 | * Writes string to outfile. 95 | * ------------------------------------------------------------------------ *) 96 | 97 | PROCEDURE WriteString ( outfile : Outfile; string : StringT ); 98 | 99 | 100 | (* --------------------------------------------------------------------------- 101 | * procedure WriteTab(outfile) 102 | * --------------------------------------------------------------------------- 103 | * Writes tab to outfile. Expands tabs to spaces if tabwidth > 0. 104 | * ------------------------------------------------------------------------ *) 105 | 106 | PROCEDURE WriteTab ( outfile : Outfile ); 107 | 108 | 109 | (* --------------------------------------------------------------------------- 110 | * procedure WriteLn(outfile) 111 | * --------------------------------------------------------------------------- 112 | * Writes newline to outfile. 113 | * ------------------------------------------------------------------------ *) 114 | 115 | PROCEDURE WriteLn ( outfile : Outfile ); 116 | 117 | 118 | (* --------------------------------------------------------------------------- 119 | * function status(outfile) 120 | * --------------------------------------------------------------------------- 121 | * Returns status of last operation. 122 | * ------------------------------------------------------------------------ *) 123 | 124 | PROCEDURE status ( outfile : Outfile ) : BasicFileIO.Status; 125 | 126 | 127 | (* --------------------------------------------------------------------------- 128 | * procedure line(outfile) 129 | * --------------------------------------------------------------------------- 130 | * Returns the line number of the current writing position of outfile. 131 | * ------------------------------------------------------------------------ *) 132 | 133 | PROCEDURE line ( outfile : Outfile ) : CARDINAL; 134 | 135 | 136 | (* --------------------------------------------------------------------------- 137 | * procedure column(outfile) 138 | * --------------------------------------------------------------------------- 139 | * Returns the column number of the current writing position of outfile. 140 | * ------------------------------------------------------------------------ *) 141 | 142 | PROCEDURE column ( outfile : Outfile ) : CARDINAL; 143 | 144 | 145 | END Outfile. -------------------------------------------------------------------------------- /src/Preprocessor.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Preprocessor; 4 | 5 | (* Modula-2 Preprocessor *) 6 | 7 | FROM Infile IMPORT InfileT; (* alias for Infile.Infile *) 8 | FROM Outfile IMPORT OutfileT; (* alias for Outfile.Outfile *) 9 | 10 | 11 | (* --------------------------------------------------------------------------- 12 | * procedure Expand(infile, outfile) 13 | * --------------------------------------------------------------------------- 14 | * Expands template file infile to output file outfile. 15 | * ------------------------------------------------------------------------ *) 16 | 17 | PROCEDURE Expand ( infile : InfileT; outfile : OutfileT ); 18 | 19 | 20 | END Preprocessor. -------------------------------------------------------------------------------- /src/Proc.iso.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) DEFINITION MODULE Proc; (* ISO version *) 2 | 3 | CONST Nil = NILPROC; 4 | 5 | END Proc. -------------------------------------------------------------------------------- /src/Proc.pim.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) DEFINITION MODULE Proc; (* PIM version *) 2 | 3 | CONST Nil = NIL; 4 | 5 | END Proc. -------------------------------------------------------------------------------- /src/Settings.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Settings; 4 | 5 | (* Program wide settings management *) 6 | 7 | IMPORT Newline, Tabulator; 8 | FROM String IMPORT StringT; (* alias for String.String *) 9 | 10 | 11 | TYPE Setting = 12 | ( Infile, Outfile, TabWidth, NewlineMode, Verbose, ShowSettings ); 13 | 14 | 15 | PROCEDURE Reset ( setting : Setting ); 16 | (* Resets setting to its default. *) 17 | 18 | 19 | PROCEDURE alreadySet ( setting : Setting ) : BOOLEAN; 20 | (* Returns TRUE if setting has been modified since last reset, else FALSE. *) 21 | 22 | 23 | PROCEDURE SetInfile ( path : StringT ); 24 | (* Sets the infile setting to path. *) 25 | 26 | 27 | PROCEDURE infile () : StringT; 28 | (* Returns the infile setting. *) 29 | 30 | 31 | PROCEDURE SetOutfile ( path : StringT ); 32 | (* Sets the outfile setting to path. *) 33 | 34 | 35 | PROCEDURE outfile () : StringT; 36 | (* Returns the outfile setting. *) 37 | 38 | 39 | PROCEDURE SetTabWidth ( value : Tabulator.TabWidth ); 40 | (* Sets the tabwidth setting to value. *) 41 | 42 | 43 | PROCEDURE tabWidth () : Tabulator.TabWidth; 44 | (* Returns the tabwidth setting. *) 45 | 46 | 47 | PROCEDURE SetNewlineMode ( mode : Newline.Mode ); 48 | (* Sets the newline mode setting to mode. *) 49 | 50 | 51 | PROCEDURE newlineMode () : Newline.Mode; 52 | (* Returns the newline mode setting. *) 53 | 54 | 55 | PROCEDURE SetVerbose ( value : BOOLEAN ); 56 | (* Sets the verbose setting. *) 57 | 58 | 59 | PROCEDURE verbose () : BOOLEAN; 60 | (* Returns the verbose setting. *) 61 | 62 | 63 | PROCEDURE SetShowSettings ( value : BOOLEAN ); 64 | (* Sets the show-settings setting. *) 65 | 66 | 67 | PROCEDURE showSettings ( ) : BOOLEAN; 68 | (* Returns the show-settings setting. *) 69 | 70 | 71 | PROCEDURE ResetAll; 72 | (* Resets all settings to their defaults. *) 73 | 74 | 75 | END Settings. -------------------------------------------------------------------------------- /src/Size.cardinal.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Size; (* CARDINAL version *) 4 | 5 | (* Whole number type with largest positive value *) 6 | 7 | 8 | (* Identifiers provided for client use: 9 | Size, SizeT, Bitwidth, BitsInUse, AddressableBits. *) 10 | 11 | TYPE Size = CARDINAL; 12 | 13 | TYPE SizeT = Size; (* alias for unqualified use *) 14 | 15 | 16 | (* --------------------------------------------------------------------------- 17 | * compile time calculation of the bit width of type Size 18 | * ------------------------------------------------------------------------ *) 19 | 20 | CONST 21 | MaxSizeDivPow2Of8 = MAX(Size) DIV 256; 22 | MaxSizeDivPow2Of16 = MaxSizeDivPow2Of8 DIV 256; 23 | MaxSizeDivPow2Of24 = MaxSizeDivPow2Of16 DIV 256; 24 | MaxSizeDivPow2Of32 = MaxSizeDivPow2Of24 DIV 256; 25 | MaxSizeDivPow2Of40 = MaxSizeDivPow2Of32 DIV 256; 26 | MaxSizeDivPow2Of48 = MaxSizeDivPow2Of40 DIV 256; 27 | MaxSizeDivPow2Of56 = MaxSizeDivPow2Of48 DIV 256; 28 | MaxSizeDivPow2Of64 = MaxSizeDivPow2Of56 DIV 256; 29 | MaxSizeDivPow2Of72 = MaxSizeDivPow2Of64 DIV 256; 30 | MaxSizeDivPow2Of80 = MaxSizeDivPow2Of72 DIV 256; 31 | MaxSizeDivPow2Of88 = MaxSizeDivPow2Of80 DIV 256; 32 | MaxSizeDivPow2Of96 = MaxSizeDivPow2Of88 DIV 256; 33 | MaxSizeDivPow2Of104 = MaxSizeDivPow2Of96 DIV 256; 34 | MaxSizeDivPow2Of112 = MaxSizeDivPow2Of104 DIV 256; 35 | MaxSizeDivPow2Of120 = MaxSizeDivPow2Of112 DIV 256; 36 | 37 | BW8 = (MAX(Size) <= 255); 38 | BW16 = (MaxSizeDivPow2Of8 > 0) AND (MaxSizeDivPow2Of8 <= 255); 39 | BW24 = (MaxSizeDivPow2Of16 > 0) AND (MaxSizeDivPow2Of16 <= 255); 40 | BW32 = (MaxSizeDivPow2Of24 > 0) AND (MaxSizeDivPow2Of24 <= 255); 41 | BW40 = (MaxSizeDivPow2Of32 > 0) AND (MaxSizeDivPow2Of32 <= 255); 42 | BW48 = (MaxSizeDivPow2Of40 > 0) AND (MaxSizeDivPow2Of40 <= 255); 43 | BW56 = (MaxSizeDivPow2Of48 > 0) AND (MaxSizeDivPow2Of48 <= 255); 44 | BW64 = (MaxSizeDivPow2Of56 > 0) AND (MaxSizeDivPow2Of56 <= 255); 45 | BW72 = (MaxSizeDivPow2Of64 > 0) AND (MaxSizeDivPow2Of64 <= 255); 46 | BW80 = (MaxSizeDivPow2Of72 > 0) AND (MaxSizeDivPow2Of72 <= 255); 47 | BW88 = (MaxSizeDivPow2Of80 > 0) AND (MaxSizeDivPow2Of80 <= 255); 48 | BW96 = (MaxSizeDivPow2Of88 > 0) AND (MaxSizeDivPow2Of88 <= 255); 49 | BW104 = (MaxSizeDivPow2Of96 > 0) AND (MaxSizeDivPow2Of96 <= 255); 50 | BW112 = (MaxSizeDivPow2Of104 > 0) AND (MaxSizeDivPow2Of104 <= 255); 51 | BW120 = (MaxSizeDivPow2Of112 > 0) AND (MaxSizeDivPow2Of112 <= 255); 52 | BW128 = (MaxSizeDivPow2Of120 > 0) AND (MaxSizeDivPow2Of120 <= 255); 53 | 54 | Bitwidth = (* storage size *) 55 | 8*ORD(BW8) + 16*ORD(BW16) + 24*ORD(BW24) + 32*ORD(BW32) + 56 | 40*ORD(BW40) + 48*ORD(BW48) + 56*ORD(BW56) + 64*ORD(BW64) + 57 | 72*ORD(BW72) + 80*ORD(BW80) + 88*ORD(BW88) + 96*ORD(BW96) + 58 | 104*ORD(BW104) + 112*ORD(BW112) + 120*ORD(BW120) + 128*ORD(BW128); 59 | 60 | BitsInUse = Bitwidth; (* apparent size *) 61 | 62 | AddressableBits = Bitwidth; (* addressable size *) 63 | 64 | 65 | END Size. -------------------------------------------------------------------------------- /src/Size.longint.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Size; (* LONGINT version *) 4 | 5 | (* Whole number type with largest positive value *) 6 | 7 | 8 | (* Identifiers provided for client use: 9 | Size, SizeT, Bitwidth, BitsInUse, AddressableBits. *) 10 | 11 | TYPE Size = LONGINT [0..MAX(LONGINT)]; 12 | 13 | TYPE SizeT = Size; (* alias for unqualified use *) 14 | 15 | 16 | (* --------------------------------------------------------------------------- 17 | * compile time calculation of the bit width of type Size 18 | * ------------------------------------------------------------------------ *) 19 | 20 | CONST 21 | MaxSizeDivPow2Of8 = MAX(Size) DIV 256; 22 | MaxSizeDivPow2Of16 = MaxSizeDivPow2Of8 DIV 256; 23 | MaxSizeDivPow2Of24 = MaxSizeDivPow2Of16 DIV 256; 24 | MaxSizeDivPow2Of32 = MaxSizeDivPow2Of24 DIV 256; 25 | MaxSizeDivPow2Of40 = MaxSizeDivPow2Of32 DIV 256; 26 | MaxSizeDivPow2Of48 = MaxSizeDivPow2Of40 DIV 256; 27 | MaxSizeDivPow2Of56 = MaxSizeDivPow2Of48 DIV 256; 28 | MaxSizeDivPow2Of64 = MaxSizeDivPow2Of56 DIV 256; 29 | MaxSizeDivPow2Of72 = MaxSizeDivPow2Of64 DIV 256; 30 | MaxSizeDivPow2Of80 = MaxSizeDivPow2Of72 DIV 256; 31 | MaxSizeDivPow2Of88 = MaxSizeDivPow2Of80 DIV 256; 32 | MaxSizeDivPow2Of96 = MaxSizeDivPow2Of88 DIV 256; 33 | MaxSizeDivPow2Of104 = MaxSizeDivPow2Of96 DIV 256; 34 | MaxSizeDivPow2Of112 = MaxSizeDivPow2Of104 DIV 256; 35 | MaxSizeDivPow2Of120 = MaxSizeDivPow2Of112 DIV 256; 36 | 37 | BW8 = (MAX(Size) <= 127); 38 | BW16 = (MaxSizeDivPow2Of8 > 0) AND (MaxSizeDivPow2Of8 <= 127); 39 | BW24 = (MaxSizeDivPow2Of16 > 0) AND (MaxSizeDivPow2Of16 <= 127); 40 | BW32 = (MaxSizeDivPow2Of24 > 0) AND (MaxSizeDivPow2Of24 <= 127); 41 | BW40 = (MaxSizeDivPow2Of32 > 0) AND (MaxSizeDivPow2Of32 <= 127); 42 | BW48 = (MaxSizeDivPow2Of40 > 0) AND (MaxSizeDivPow2Of40 <= 127); 43 | BW56 = (MaxSizeDivPow2Of48 > 0) AND (MaxSizeDivPow2Of48 <= 127); 44 | BW64 = (MaxSizeDivPow2Of56 > 0) AND (MaxSizeDivPow2Of56 <= 127); 45 | BW72 = (MaxSizeDivPow2Of64 > 0) AND (MaxSizeDivPow2Of64 <= 127); 46 | BW80 = (MaxSizeDivPow2Of72 > 0) AND (MaxSizeDivPow2Of72 <= 127); 47 | BW88 = (MaxSizeDivPow2Of80 > 0) AND (MaxSizeDivPow2Of80 <= 127); 48 | BW96 = (MaxSizeDivPow2Of88 > 0) AND (MaxSizeDivPow2Of88 <= 127); 49 | BW104 = (MaxSizeDivPow2Of96 > 0) AND (MaxSizeDivPow2Of96 <= 127); 50 | BW112 = (MaxSizeDivPow2Of104 > 0) AND (MaxSizeDivPow2Of104 <= 127); 51 | BW120 = (MaxSizeDivPow2Of112 > 0) AND (MaxSizeDivPow2Of112 <= 127); 52 | BW128 = (MaxSizeDivPow2Of120 > 0) AND (MaxSizeDivPow2Of120 <= 127); 53 | 54 | Bitwidth = (* storage size *) 55 | 8*ORD(BW8) + 16*ORD(BW16) + 24*ORD(BW24) + 32*ORD(BW32) + 56 | 40*ORD(BW40) + 48*ORD(BW48) + 56*ORD(BW56) + 64*ORD(BW64) + 57 | 72*ORD(BW72) + 80*ORD(BW80) + 88*ORD(BW88) + 96*ORD(BW96) + 58 | 104*ORD(BW104) + 112*ORD(BW112) + 120*ORD(BW120) + 128*ORD(BW128); 59 | 60 | BitsInUse = Bitwidth - 1; (* apparent size *) 61 | 62 | AddressableBits = Bitwidth - 1; (* addressable size *) 63 | 64 | 65 | END Size. -------------------------------------------------------------------------------- /src/Tabulator.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Tabulator; 4 | 5 | (* Tabulator management *) 6 | 7 | CONST 8 | Default = 0; 9 | MaxTabWidth = 8; 10 | 11 | TYPE TabWidth = CARDINAL [0..MaxTabWidth]; 12 | 13 | 14 | PROCEDURE SetTabWidth ( value : TabWidth ); 15 | (* Sets the tab width. Zero leaves tabs in place. *) 16 | 17 | 18 | PROCEDURE tabWidth ( ) : TabWidth; 19 | (* Returns the tab width. *) 20 | 21 | 22 | END Tabulator. -------------------------------------------------------------------------------- /src/Terminal.nonpim.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Terminal; (* PIM Library Substitute *) 4 | 5 | (* This module is part of PIM Modula-2. Thus PIM compilers generally ship with 6 | a vendor provided library that includes Terminal. This substitute library 7 | is provided for ISO compilers that do not ship with Terminal or for POSIX 8 | systems when a purely POSIX based build configuration is desired to avoid 9 | dependencies on PIM libraries. *) 10 | 11 | 12 | (* --------------------------------------------------------------------------- 13 | * procedure Read(ch) 14 | * --------------------------------------------------------------------------- 15 | * Blocking read operation. Reads a character from standard input. 16 | * ------------------------------------------------------------------------ *) 17 | 18 | PROCEDURE Read ( VAR ch : CHAR ); 19 | 20 | 21 | (* --------------------------------------------------------------------------- 22 | * procedure Write(ch) 23 | * --------------------------------------------------------------------------- 24 | * Writes the given character to standard output. 25 | * ------------------------------------------------------------------------ *) 26 | 27 | PROCEDURE Write ( ch : CHAR ); 28 | 29 | 30 | (* --------------------------------------------------------------------------- 31 | * procedure WriteString(array) 32 | * --------------------------------------------------------------------------- 33 | * Writes the given character array to standard output. 34 | * ------------------------------------------------------------------------ *) 35 | 36 | PROCEDURE WriteString ( array : ARRAY OF CHAR ); 37 | 38 | 39 | (* --------------------------------------------------------------------------- 40 | * procedure WriteLn 41 | * --------------------------------------------------------------------------- 42 | * Writes newline to standard output. 43 | * ------------------------------------------------------------------------ *) 44 | 45 | PROCEDURE WriteLn; 46 | 47 | 48 | END Terminal. -------------------------------------------------------------------------------- /src/Terminal.pim.txt: -------------------------------------------------------------------------------- 1 | Module Terminal is part of PIM. It should be included in any PIM Modula-2 compiler's library. 2 | -------------------------------------------------------------------------------- /src/dep/ArgLexer.dep.dot: -------------------------------------------------------------------------------- 1 | digraph ArgLexerImports { 2 | node [fontname=helvetica]; 3 | 4 | ArgLexer -> { 5 | Infile ISO646 String 6 | }; 7 | 8 | Infile -> { 9 | BasicFileIO BuildParams ISO646 Storage String 10 | }; 11 | 12 | BasicFileIO -> { 13 | BasicFileSys IOSubsystem ISO646 Storage 14 | }; 15 | 16 | BasicFileSys -> { 17 | Size IOSubsystem 18 | }; 19 | 20 | Size; /* no dependencies */ 21 | 22 | IOSubsystem [label="I/O Subsystem";shape=box]; 23 | 24 | ISO646; /* no dependencies */ 25 | 26 | Storage [shape=box]; /* stdlib */ 27 | 28 | BuildParams; /* no dependencies */ 29 | 30 | String -> { 31 | Hash ISO646 Storage StrBlank 32 | }; 33 | 34 | Hash -> { 35 | Size 36 | }; 37 | 38 | StrBlank; /* no dependencies */ 39 | 40 | } /* ArgLexerImports */ -------------------------------------------------------------------------------- /src/dep/ArgParser.dep.dot: -------------------------------------------------------------------------------- 1 | digraph ArgParserImports { 2 | node [fontname=helvetica]; 3 | 4 | ArgParser -> { 5 | ArgLexer Newline NumStr Settings String Tabulator 6 | }; 7 | 8 | ArgLexer -> { 9 | Infile ISO646 String 10 | }; 11 | 12 | Infile -> { 13 | BasicFileIO BuildParams ISO646 Storage String 14 | }; 15 | 16 | BasicFileIO -> { 17 | BasicFileSys IOSubsystem ISO646 Storage 18 | }; 19 | 20 | BasicFileSys -> { 21 | Size IOSubsystem 22 | }; 23 | 24 | Size; /* no dependencies */ 25 | 26 | IOSubsystem [label="I/O Subsystem";shape=box]; 27 | 28 | ISO646; /* no dependencies */ 29 | 30 | Storage [shape=box]; /* stdlib */ 31 | 32 | BuildParams; /* no dependencies */ 33 | 34 | String -> { 35 | Hash ISO646 Storage StrBlank 36 | }; 37 | 38 | Hash -> { 39 | Size 40 | }; 41 | 42 | StrBlank; /* no dependencies */ 43 | 44 | Newline; /* no dependencies */ 45 | 46 | NumStr -> { 47 | String 48 | }; 49 | 50 | Settings -> { 51 | String Newline Tabulator 52 | }; 53 | 54 | Tabulator; /* no dependencies */ 55 | 56 | } /* ArgParserImports */ -------------------------------------------------------------------------------- /src/dep/Args.dep.dot: -------------------------------------------------------------------------------- 1 | digraph ArgsImports { 2 | node [fontname=helvetica]; 3 | 4 | Args -> { 5 | BuildParams CharArray Console BasicFileSys Infile ISO646 Outfile String 6 | }; 7 | 8 | BuildParams; /* no dependencies */ 9 | 10 | CharArray -> { 11 | ISO646 12 | }; 13 | 14 | ISO646; /* no dependencies */ 15 | 16 | Console -> { 17 | CardMath ISO646 String Terminal 18 | }; 19 | 20 | CardMath; /* no dependencies */ 21 | 22 | String -> { 23 | Hash ISO646 Storage StrBlank 24 | }; 25 | 26 | Hash -> { 27 | Size 28 | }; 29 | 30 | Size; /* no dependencies */ 31 | 32 | Storage [shape=box]; /* stdlib */ 33 | 34 | StrBlank; /* no dependencies */ 35 | 36 | Terminal [shape=box]; /* stdlib */ 37 | 38 | BasicFileSys -> { 39 | Size IOSubsystem 40 | }; 41 | 42 | IOSubsystem [label="I/O Subsystem";shape=box]; 43 | 44 | Infile -> { 45 | BasicFileIO BuildParams ISO646 Storage String 46 | }; 47 | 48 | BasicFileIO -> { 49 | BasicFileSys IOSubsystem ISO646 Storage 50 | }; 51 | 52 | Storage [shape=box]; /* stdlib */ 53 | 54 | Outfile -> { 55 | BasicFileIO ISO646 Newline String Tabulator 56 | }; 57 | 58 | Newline; /* no dependencies */ 59 | 60 | Tabulator; /* no dependencies */ 61 | 62 | } /* Args */ -------------------------------------------------------------------------------- /src/dep/BasicFileIO.dep.dot: -------------------------------------------------------------------------------- 1 | digraph BasicFileIODep { 2 | node [fontname=helvetica]; 3 | 4 | BasicFileIO -> { 5 | BasicFileSys IOSubsystem ISO646 Storage 6 | }; 7 | 8 | BasicFileSys -> { 9 | Size IOSubsystem 10 | }; 11 | 12 | Size; /* no dependencies */ 13 | 14 | IOSubsystem [label="I/O Subsystem";shape=box]; 15 | 16 | ISO646; /* no dependencies */ 17 | 18 | Storage [shape=box]; /* stdlib */ 19 | 20 | } /* BasicFileIODep */ -------------------------------------------------------------------------------- /src/dep/BasicFileSys.dep.dot: -------------------------------------------------------------------------------- 1 | digraph BasicFileSysDep { 2 | node [fontname=helvetica]; 3 | 4 | BasicFileSys -> { 5 | Size IOSubsystem 6 | }; 7 | 8 | Size; /* no dependencies */ 9 | 10 | IOSubsystem [label="I/O Subsystem";shape=box]; 11 | 12 | } /* BasicFileSysDep */ -------------------------------------------------------------------------------- /src/dep/BuildParams.dep.dot: -------------------------------------------------------------------------------- 1 | digraph BuildParamsDep { 2 | node [fontname=helvetica]; 3 | 4 | BuildParams; /* no dependencies */ 5 | 6 | } /* BuildParamsDep */ -------------------------------------------------------------------------------- /src/dep/CardMath.dep.dot: -------------------------------------------------------------------------------- 1 | digraph CardMathDep { 2 | node [fontname=helvetica]; 3 | 4 | CardMath; /* no dependencies */ 5 | 6 | } /* CardMathDep */ -------------------------------------------------------------------------------- /src/dep/CharArray.dep.dot: -------------------------------------------------------------------------------- 1 | digraph CharArrayDep { 2 | node [fontname=helvetica]; 3 | 4 | CharArray -> { 5 | ISO646 6 | }; 7 | 8 | } /* CharArrayDep */ -------------------------------------------------------------------------------- /src/dep/Console.dep.dot: -------------------------------------------------------------------------------- 1 | digraph ConsoleDep { 2 | node [fontname=helvetica]; 3 | 4 | Console -> { 5 | CardMath ISO646 String Terminal 6 | }; 7 | 8 | CardMath; /* no dependencies */ 9 | 10 | ISO646; /* no dependencies */ 11 | 12 | String -> { 13 | Hash ISO646 Storage StrBlank 14 | }; 15 | 16 | Hash -> { 17 | Size 18 | }; 19 | 20 | Size; /* no dependencies */ 21 | 22 | Storage [shape=box]; /* stdlib */ 23 | 24 | StrBlank; /* no dependencies */ 25 | 26 | Terminal [shape=box]; /* stdlib */ 27 | 28 | } /* ConsoleDep */ -------------------------------------------------------------------------------- /src/dep/Dictionary.dep.dot: -------------------------------------------------------------------------------- 1 | digraph DictionaryDep { 2 | node [fontname=helvetica]; 3 | 4 | Dictionary -> { 5 | Proc Storage String 6 | }; 7 | 8 | Proc; /* no dependencies */ 9 | 10 | Storage [shape=box]; /* stdlib */ 11 | 12 | String -> { 13 | Hash ISO646 Storage StrBlank 14 | }; 15 | 16 | Hash -> { 17 | Size 18 | }; 19 | 20 | Size; /* no dependencies */ 21 | 22 | ISO646; /* no dependencies */ 23 | 24 | StrBlank; /* no dependencies */ 25 | 26 | } /* DictionaryDep */ -------------------------------------------------------------------------------- /src/dep/FNStr.dep.dot: -------------------------------------------------------------------------------- 1 | digraph FNStrDep { 2 | node [fontname=helvetica]; 3 | 4 | FNStr -> { 5 | CardMath ISO646 String 6 | }; 7 | 8 | CardMath; /* no dependencies */ 9 | 10 | ISO646; /* no dependencies */ 11 | 12 | String -> { 13 | Hash ISO646 Storage StrBlank 14 | }; 15 | 16 | Hash -> { 17 | Size 18 | }; 19 | 20 | Size; /* no dependencies */ 21 | 22 | Storage [shape=box]; /* stdlib */ 23 | 24 | StrBlank; /* no dependencies */ 25 | 26 | } /* FNStrDep */ -------------------------------------------------------------------------------- /src/dep/Hash.dep.dot: -------------------------------------------------------------------------------- 1 | digraph HashDep { 2 | node [fontname=helvetica]; 3 | 4 | Hash -> { 5 | Size 6 | }; 7 | 8 | Size; /* no dependencies */ 9 | 10 | } /* HashDep */ -------------------------------------------------------------------------------- /src/dep/ISO646.dep.dot: -------------------------------------------------------------------------------- 1 | digraph ISO646Dep { 2 | node [fontname=helvetica]; 3 | 4 | ISO646; /* no dependencies */ 5 | 6 | } /* ISO646Dep */ -------------------------------------------------------------------------------- /src/dep/Infile.dep.dot: -------------------------------------------------------------------------------- 1 | digraph InfileDep { 2 | node [fontname=helvetica]; 3 | 4 | Infile -> { 5 | BasicFileIO BuildParams ISO646 Storage String 6 | }; 7 | 8 | BasicFileIO -> { 9 | BasicFileSys IOSubsystem ISO646 Storage 10 | }; 11 | 12 | BasicFileSys -> { 13 | Size IOSubsystem 14 | }; 15 | 16 | Size; /* no dependencies */ 17 | 18 | IOSubsystem [label="I/O Subsystem";shape=box]; 19 | 20 | ISO646; /* no dependencies */ 21 | 22 | Storage [shape=box]; /* stdlib */ 23 | 24 | BuildParams; /* no dependencies */ 25 | 26 | String -> { 27 | Hash ISO646 Storage StrBlank 28 | }; 29 | 30 | Hash -> { 31 | Size 32 | }; 33 | 34 | StrBlank; /* no dependencies */ 35 | 36 | } /* InfileDep */ -------------------------------------------------------------------------------- /src/dep/M2PP.dep.dot: -------------------------------------------------------------------------------- 1 | digraph M2PPDep { 2 | node [fontname=helvetica]; 3 | 4 | M2PP -> { 5 | Args ArgParser BuildParams BasicFileSys FNStr Infile Outfile Preprocessor 6 | }; 7 | 8 | Args -> { 9 | BuildParams CharArray Console BasicFileSys Infile ISO646 Outfile String 10 | }; 11 | 12 | BuildParams; /* no dependencies */ 13 | 14 | CharArray -> { 15 | ISO646 16 | }; 17 | 18 | ISO646; /* no dependencies */ 19 | 20 | Console -> { 21 | CardMath ISO646 String Terminal 22 | }; 23 | 24 | CardMath; /* no dependencies */ 25 | 26 | String -> { 27 | Hash ISO646 Storage StrBlank 28 | }; 29 | 30 | Hash -> { 31 | Size 32 | }; 33 | 34 | Size; /* no dependencies */ 35 | 36 | Storage [shape=box]; /* stdlib */ 37 | 38 | StrBlank; /* no dependencies */ 39 | 40 | BasicFileSys -> { 41 | Size IOSubsystem 42 | }; 43 | 44 | IOSubsystem [label="I/O Subsystem";shape=box]; 45 | 46 | Infile -> { 47 | BasicFileIO BuildParams ISO646 Storage String 48 | }; 49 | 50 | BasicFileIO -> { 51 | BasicFileSys IOSubsystem ISO646 Storage 52 | }; 53 | 54 | Outfile -> { 55 | BasicFileIO ISO646 Newline String Tabulator 56 | }; 57 | 58 | Newline; /* no dependencies */ 59 | 60 | Tabulator; /* no dependencies */ 61 | 62 | ArgParser -> { 63 | ArgLexer Newline NumStr Settings String Tabulator 64 | }; 65 | 66 | ArgLexer -> { 67 | Infile ISO646 String 68 | }; 69 | 70 | NumStr -> { 71 | String 72 | }; 73 | 74 | Settings -> { 75 | String Newline Tabulator 76 | }; 77 | 78 | FNStr -> { 79 | CardMath ISO646 String 80 | }; 81 | 82 | CardMath; /* no dependencies */ 83 | 84 | Preprocessor -> { 85 | Dictionary Infile ISO646 Outfile String 86 | }; 87 | 88 | Dictionary -> { 89 | Proc Storage String 90 | }; 91 | 92 | Proc; /* no dependencies */ 93 | 94 | } /* M2PPDep */ -------------------------------------------------------------------------------- /src/dep/Newline.dep.dot: -------------------------------------------------------------------------------- 1 | digraph NewlineDep { 2 | node [fontname=helvetica]; 3 | 4 | Newline; /* no dependencies */ 5 | 6 | } /* NewlineDep */ -------------------------------------------------------------------------------- /src/dep/NumStr.dep.dot: -------------------------------------------------------------------------------- 1 | digraph NumStrDep { 2 | node [fontname=helvetica]; 3 | 4 | NumStr -> { 5 | String 6 | }; 7 | 8 | String -> { 9 | Hash ISO646 Storage StrBlank 10 | }; 11 | 12 | Hash -> { 13 | Size 14 | }; 15 | 16 | Size; /* no dependencies */ 17 | 18 | ISO646; /* no dependencies */ 19 | 20 | Storage [shape=box]; /* stdlib */ 21 | 22 | StrBlank; /* no dependencies */ 23 | 24 | } /* NumStrDep */ -------------------------------------------------------------------------------- /src/dep/Outfile.dep.dot: -------------------------------------------------------------------------------- 1 | digraph OutfileDep { 2 | node [fontname=helvetica]; 3 | 4 | Outfile -> { 5 | BasicFileIO ISO646 Newline String Tabulator 6 | }; 7 | 8 | BasicFileIO -> { 9 | BasicFileSys IOSubsystem ISO646 Storage 10 | }; 11 | 12 | BasicFileSys -> { 13 | Size IOSubsystem 14 | }; 15 | 16 | Size; /* no dependencies */ 17 | 18 | IOSubsystem [label="I/O Subsystem";shape=box]; 19 | 20 | ISO646; /* no dependencies */ 21 | 22 | Storage [shape=box]; /* stdlib */ 23 | 24 | Newline; /* no dependencies */ 25 | 26 | String -> { 27 | Hash ISO646 Storage StrBlank 28 | }; 29 | 30 | Hash -> { 31 | Size 32 | }; 33 | 34 | StrBlank; /* no dependencies */ 35 | 36 | Tabulator; /* no dependencies */ 37 | 38 | } /* OutfileDep */ -------------------------------------------------------------------------------- /src/dep/Preprocessor.dep.dot: -------------------------------------------------------------------------------- 1 | digraph PreprocessorDep { 2 | node [fontname=helvetica]; 3 | 4 | Preprocessor -> { 5 | Dictionary Infile ISO646 Outfile String 6 | }; 7 | 8 | Dictionary -> { 9 | Proc Storage String 10 | }; 11 | 12 | Proc; /* no dependencies */ 13 | 14 | Storage [shape=box]; /* stdlib */ 15 | 16 | String -> { 17 | Hash ISO646 Storage StrBlank 18 | }; 19 | 20 | Hash -> { 21 | Size 22 | }; 23 | 24 | Size; /* no dependencies */ 25 | 26 | ISO646; /* no dependencies */ 27 | 28 | StrBlank; /* no dependencies */ 29 | 30 | Infile -> { 31 | BasicFileIO BuildParams ISO646 Storage String 32 | }; 33 | 34 | BasicFileIO -> { 35 | BasicFileSys IOSubsystem ISO646 Storage 36 | }; 37 | 38 | BasicFileSys -> { 39 | Size IOSubsystem 40 | }; 41 | 42 | IOSubsystem [label="I/O Subsystem";shape=box]; 43 | 44 | BuildParams; /* no dependencies */ 45 | 46 | Outfile -> { 47 | BasicFileIO ISO646 Newline String Tabulator 48 | }; 49 | 50 | Newline; /* no dependencies */ 51 | 52 | Tabulator; /* no dependencies */ 53 | 54 | } /* PreprocessorDep */ -------------------------------------------------------------------------------- /src/dep/Proc.dep.dot: -------------------------------------------------------------------------------- 1 | digraph ProcDep { 2 | node [fontname=helvetica]; 3 | 4 | Proc; /* no dependencies */ 5 | 6 | } /* ProcDep */ -------------------------------------------------------------------------------- /src/dep/Settings.dep.dot: -------------------------------------------------------------------------------- 1 | digraph SettingsDep { 2 | node [fontname=helvetica]; 3 | 4 | Settings -> { 5 | String Newline Tabulator 6 | }; 7 | 8 | String -> { 9 | Hash ISO646 Storage StrBlank 10 | }; 11 | 12 | Hash -> { 13 | Size 14 | }; 15 | 16 | Size; /* no dependencies */ 17 | 18 | ISO646; /* no dependencies */ 19 | 20 | Storage [shape=box]; /* stdlib */ 21 | 22 | StrBlank; /* no dependencies */ 23 | 24 | Newline; /* no dependencies */ 25 | 26 | Tabulator; /* no dependencies */ 27 | 28 | } /* SettingsDep */ -------------------------------------------------------------------------------- /src/dep/String.dep.dot: -------------------------------------------------------------------------------- 1 | digraph StringDep { 2 | node [fontname=helvetica]; 3 | 4 | String -> { 5 | Hash ISO646 Storage StrBlank 6 | }; 7 | 8 | Hash -> { 9 | Size 10 | }; 11 | 12 | Size; /* no dependencies */ 13 | 14 | ISO646; /* no dependencies */ 15 | 16 | Storage [shape=box]; /* stdlib */ 17 | 18 | StrBlank; /* no dependencies */ 19 | 20 | } /* StringDep */ -------------------------------------------------------------------------------- /src/dep/Tabulator.dep.dot: -------------------------------------------------------------------------------- 1 | digraph TabulatorDep { 2 | node [fontname=helvetica]; 3 | 4 | Tabulator; /* no dependencies */ 5 | 6 | } /* TabulatorDep */ -------------------------------------------------------------------------------- /src/imp/Args.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE Args; 4 | 5 | (* Program Argument Management *) 6 | 7 | IMPORT ISO646, CharArray, Console, BasicFileSys, Infile, Outfile, String; 8 | 9 | FROM BuildParams IMPORT ArgQueryBufferSize; 10 | FROM String IMPORT StringT; (* alias for String.String *) 11 | 12 | 13 | VAR 14 | isOpen : BOOLEAN; 15 | argsFile : InfileT; 16 | 17 | 18 | PROCEDURE Open; 19 | (* Opens the command line argument file. *) 20 | 21 | VAR 22 | status : Infile.Status; 23 | 24 | BEGIN 25 | Infile.Open(argsFile, Filename, status); 26 | isOpen := (status = Infile.Success) 27 | END Open; 28 | 29 | 30 | PROCEDURE Close; 31 | (* Closes the command line argument file. *) 32 | 33 | BEGIN 34 | Infile.Close(argsFile); 35 | argsFile := Infile.Nil; 36 | isOpen := FALSE 37 | END Close; 38 | 39 | 40 | PROCEDURE Delete; 41 | (* Deletes the command line argument file. *) 42 | 43 | VAR 44 | status : BasicFileSys.Status; 45 | 46 | BEGIN 47 | IF NOT isOpen THEN 48 | BasicFileSys.DeleteFile(Filename, status) 49 | END (* IF *) 50 | END Delete; 51 | 52 | 53 | PROCEDURE Query; 54 | (* Queries program args and writes argument file. *) 55 | 56 | VAR 57 | argStr : ARRAY [0..ArgQueryBufferSize] OF CHAR; 58 | tmpFile : InfileT; 59 | status : Infile.Status; 60 | 61 | BEGIN 62 | (* prompt *) 63 | Console.WriteChars("args> "); 64 | 65 | (* read user input *) 66 | argStr[0] := ISO646.NUL; 67 | Console.ReadChars(argStr); 68 | 69 | (* remove leading and trailing space *) 70 | CharArray.Trim(argStr); 71 | 72 | (* bail out if user input is empty *) 73 | IF argStr[0] = ISO646.NUL THEN 74 | RETURN 75 | END; (* IF *) 76 | 77 | (* open/create argument file *) 78 | Outfile.Open(tmpFile, Filename, status); 79 | 80 | (* bail out if file couldn't be opened/created *) 81 | IF status # Outfile.Success THEN 82 | Console.WriteChars("unable to open/create "); 83 | Console.WriteChars(Filename); 84 | Console.WriteChars(".\n"); 85 | RETURN 86 | END; (* IF *) 87 | 88 | (* write argStr to argument file *) 89 | Outfile.WriteChars(argStr); 90 | Outfile.Close(tmpFile); 91 | 92 | (* open argument file for argument parser *) 93 | Infile.Open(argsFile, Filename, status); 94 | 95 | (* bail out if file couldn't be opened *) 96 | IF status # Infile.Success THEN 97 | Console.WriteChars("unable to open "); 98 | Console.WriteChars(Filename); 99 | Console.WriteChars(".\n"); 100 | RETURN 101 | END; (* IF *) 102 | 103 | isOpen := TRUE 104 | END Query; 105 | 106 | 107 | PROCEDURE file () : InfileT; 108 | (* Returns a file handle to the command line argument file, NIL if closed. *) 109 | 110 | BEGIN 111 | RETURN argsFile 112 | END file; 113 | 114 | 115 | BEGIN 116 | isOpen := FALSE; 117 | argsFile := Infile.Nil 118 | END Args. -------------------------------------------------------------------------------- /src/imp/BasicFileSys/BasicFileSys.adw.mod: -------------------------------------------------------------------------------- 1 | (*!m2iso+sbu*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE BasicFileSys; (* ADW version *) 4 | 5 | (* Clean file system interface to the junk that comes with ISO *) 6 | 7 | IMPORT ChanConsts, RndFile; (* ISO libraries *) 8 | 9 | IMPORT RTL; (* ADW specific library *) 10 | 11 | IMPORT Size; 12 | 13 | 14 | CONST 15 | Opened = ChanConsts.opened; 16 | NotFound = ChanConsts.noSuchFile; 17 | ExistsAlready = ChanConsts.fileExists; 18 | OpenAlready = ChanConsts.alreadyOpen; 19 | 20 | 21 | PROCEDURE fileExists ( path : ARRAY OF CHAR ) : BOOLEAN; 22 | (* Returns TRUE if the file at the given path exists, else FALSE. *) 23 | 24 | VAR 25 | found : BOOLEAN; 26 | f : RndFile.ChanId; 27 | res : RndFile.OpenResults; 28 | 29 | (* The ISO library doesn't provide any file lookup function. So we have 30 | no choice but to open a file just to see if it exists, and if it does 31 | exist then we have to close it again. This is bad design. *) 32 | 33 | BEGIN 34 | (* Why do we need to decide between sequential, stream and random access 35 | when all we want is check if a file exists? Incredibly bad design. *) 36 | 37 | RndFile.OpenOld(f, path, RndFile.read+RndFile.old, res); 38 | 39 | (* There are plenty of failure result codes that do not actually tell us 40 | whether or not the file exists. We have no choice but to deem that it 41 | doesn't exist if any of these failure codes are reported back. 42 | The incompetence in the ISO I/O library design is staggering. *) 43 | found := 44 | (res = Opened) OR 45 | (res = ExistsAlready) OR 46 | (res = OpenAlready); 47 | 48 | IF res = Opened THEN 49 | RndFile.Close(f) 50 | END; (* IF *) 51 | 52 | RETURN found 53 | END fileExists; 54 | 55 | 56 | PROCEDURE GetFileSize 57 | ( path : ARRAY OF CHAR; VAR size : FileSize; VAR status : Status ); 58 | (* Obtains the size of the file at path. On success, the size is passed back 59 | in size and Success is passed back in status. On failure, size remains 60 | unmodified, FileNotFound, SizeOverflow or Failure is passed in status. *) 61 | 62 | (* This procedure requires FilePos arithmetic and conversion which is not 63 | supported by all ISO Modula-2 compilers. For a truly portable but very 64 | inefficient implementation of GetFileSize, see BasicFileSys.p1.mod. *) 65 | 66 | BEGIN 67 | RndFile.OpenOld(f, path, RndFile.read+RndFile.old, res); 68 | 69 | found := 70 | (res = Opened) OR 71 | (res = ExistsAlready) OR 72 | (res = OpenAlready); 73 | 74 | IF NOT found THEN 75 | status := FileNotFound; 76 | RETURN 77 | END; (* IF *) 78 | 79 | IF res # Opened THEN 80 | status := Failure; 81 | RETURN 82 | END; (* IF *) 83 | 84 | fileSize := RndFile.EndPos(f); 85 | RndFile.Close(f); 86 | 87 | IF wouldOverflowFileSize(fileSize) THEN 88 | status := SizeOverflow; 89 | RETURN 90 | END; (* IF *) 91 | 92 | size := VAL(FileSize, fileSize); 93 | status := Success 94 | END GetFileSize; 95 | 96 | 97 | PROCEDURE CreateFile ( path : ARRAY OF CHAR; VAR status : Status ); 98 | (* Creates a new file with the given pathname and passes back status. *) 99 | 100 | VAR 101 | f : RndFile.ChanId; 102 | res : RndFile.OpenResults; 103 | 104 | BEGIN 105 | RndFile.OpenClean(f, path, RndFile.write, res); 106 | 107 | IF res = Opened THEN 108 | status := Success; 109 | RndFile.Close(f) 110 | 111 | ELSIF (res = ExistsAlready) OR (res = OpenAlready) THEN 112 | status := FileAlreadyExists 113 | ELSE 114 | status := Failure 115 | END (* IF *) 116 | END CreateFile; 117 | 118 | 119 | PROCEDURE RenameFile ( path, newPath : ARRAY OF CHAR; VAR status : Status ); 120 | (* Renames the file at path to newPath and passes back status. *) 121 | 122 | VAR 123 | done : BOOLEAN; 124 | 125 | BEGIN 126 | IF NOT fileExists(path) THEN 127 | status := FileNotFound; 128 | RETURN 129 | END; (* IF *) 130 | 131 | IF fileExists(newPath) THEN 132 | status := FileAlreadyExists; 133 | RETURN 134 | END; (* IF *) 135 | 136 | done := RTL.RenameFile(path, newPath); (* ADW specific call *) 137 | 138 | IF done THEN 139 | status := Success 140 | ELSE 141 | status := Failure 142 | END (* IF *) 143 | END RenameFile; 144 | 145 | 146 | PROCEDURE DeleteFile ( path : ARRAY OF CHAR; VAR status : Status ); 147 | (* Deletes the file at path and passes status in done. *) 148 | 149 | VAR 150 | done : BOOLEAN; 151 | 152 | BEGIN 153 | IF NOT fileExists(path) THEN 154 | status := FileNotFound; 155 | RETURN 156 | END; (* IF *) 157 | 158 | done := RTL.DeleteFile(path); (* ADW specific call *) 159 | 160 | IF done THEN 161 | status := Success 162 | ELSE 163 | status := Failure 164 | END (* IF *) 165 | END DeleteFile; 166 | 167 | 168 | (* ************************************************************************ * 169 | * Private Operations * 170 | * ************************************************************************ *) 171 | 172 | (* -------------------------------------------------------------------------- 173 | * function wouldOverflowFileSize(size) 174 | * -------------------------------------------------------------------------- 175 | * Returns TRUE if size > MAX(FileSize), else FALSE. 176 | * ----------------------------------------------------------------------- *) 177 | 178 | PROCEDURE wouldOverflowFileSize ( size : RndFile.FilePos ) : BOOLEAN; 179 | 180 | VAR 181 | bits : CARDINAL; 182 | weight, maxWeight : RndFile.FilePos; 183 | 184 | BEGIN 185 | bits := 0; 186 | weight := 1; 187 | maxWeight := size DIV 2 + 1; 188 | 189 | (* calculate required bits *) 190 | WHILE weight < maxWeight DO 191 | bits := bits + 1; 192 | weight := weight * 2 193 | END; (* WHILE *) 194 | 195 | RETURN ((bits + 1) > Size.BitsInUse) 196 | END wouldOverflowFileSize; 197 | 198 | 199 | END BasicFileSys. -------------------------------------------------------------------------------- /src/imp/BasicFileSys/BasicFileSys.gpm.mod: -------------------------------------------------------------------------------- 1 | (*!m2iso+gpm*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE BasicFileSys; (* GPM version *) 4 | 5 | IMPORT FLength, UxFiles; (* GPM specific libraries *) 6 | 7 | IMPORT Size; 8 | 9 | 10 | PROCEDURE fileExists ( path : ARRAY OF CHAR ) : BOOLEAN; 11 | (* Returns TRUE if the file at the given path exists, else FALSE. *) 12 | 13 | VAR 14 | done : BOOLEAN; 15 | mode : UxFiles.FileMode; 16 | 17 | BEGIN 18 | mode := UxFiles.FileMode { UxFiles.isreg }; 19 | UxFiles.GetMode(path, mode, done); 20 | 21 | IF NOT done THEN 22 | RETURN FALSE 23 | END; (* IF *) 24 | 25 | RETURN (UxFiles.isreg IN mode) 26 | END fileExists; 27 | 28 | 29 | PROCEDURE GetFileSize 30 | ( path : ARRAY OF CHAR; VAR size : FileSize; VAR status : Status ); 31 | (* Obtains the size of the file at path. On success, the size is passed back 32 | in size and Success is passed back in status. On failure, size remains 33 | unmodified, FileNotFound, SizeOverflow or Failure is passed in status. *) 34 | 35 | VAR 36 | done : BOOLEAN; 37 | fileSize : CARDINAL; 38 | 39 | BEGIN 40 | IF NOT fileExists(path) THEN 41 | status := FileNotFound; 42 | RETURN 43 | END; (* IF *) 44 | 45 | UxFiles.FileSize(path, fileSize, done); 46 | 47 | IF NOT done THEN 48 | (* subsystem returned failure *) 49 | status := Failure; 50 | RETURN 51 | END; (* IF *) 52 | 53 | IF wouldOverflowFileSize(fileSize) THEN 54 | status := SizeOverflow; 55 | RETURN 56 | END; (* IF *) 57 | 58 | size := VAL(FileSize, fileSize); 59 | status := Success 60 | END GetFileSize; 61 | 62 | 63 | PROCEDURE CreateFile ( path : ARRAY OF CHAR; VAR status : Status ); 64 | (* Creates a new file with the given pathname and passes back status. *) 65 | 66 | VAR 67 | done : BOOLEAN; 68 | f : UxFiles.File; 69 | 70 | BEGIN 71 | IF fileExists(path) THEN 72 | status := FileAlreadyExists; 73 | RETURN 74 | END; (* IF *) 75 | 76 | UxFiles.Create(f, path, done); (* GPM specific call *) 77 | 78 | IF done THEN 79 | status := Success; 80 | UxFiles.Close(f, done) 81 | ELSE 82 | status := Failure 83 | END (* IF *) 84 | END CreateFile; 85 | 86 | 87 | PROCEDURE RenameFile ( path, newPath : ARRAY OF CHAR; VAR status : Status ); 88 | (* Renames the file at path to newPath and passes back status. *) 89 | 90 | VAR 91 | done : BOOLEAN; 92 | 93 | BEGIN 94 | IF NOT fileExists(path) THEN 95 | status := FileNotFound; 96 | RETURN 97 | END; (* IF *) 98 | 99 | IF fileExists(newPath) THEN 100 | status := FileAlreadyExists; 101 | RETURN 102 | END; (* IF *) 103 | 104 | Flength.RenameFile(path, newPath, done); (* GPM specific call *) 105 | 106 | IF done THEN 107 | status := Success 108 | ELSE 109 | status := Failure 110 | END (* IF *) 111 | END RenameFile; 112 | 113 | 114 | PROCEDURE DeleteFile ( path : ARRAY OF CHAR; VAR status : Status ); 115 | (* Deletes the file at path and passes status in done. *) 116 | 117 | VAR 118 | done : BOOLEAN; 119 | 120 | BEGIN 121 | IF NOT fileExists(path) THEN 122 | status := FileNotFound; 123 | RETURN 124 | END; (* IF *) 125 | 126 | UxFiles.DeleteFile(path, done); (* GPM specific call *) 127 | 128 | IF done THEN 129 | status := Success 130 | ELSE 131 | status := Failure 132 | END (* IF *) 133 | END DeleteFile; 134 | 135 | 136 | (* ************************************************************************ * 137 | * Private Operations * 138 | * ************************************************************************ *) 139 | 140 | (* -------------------------------------------------------------------------- 141 | * function wouldOverflowFileSize(size) 142 | * -------------------------------------------------------------------------- 143 | * Returns TRUE if size > MAX(CARDINAL), else FALSE. 144 | * ----------------------------------------------------------------------- *) 145 | 146 | PROCEDURE wouldOverflowFileSize ( size : CARDINAL ) : BOOLEAN; 147 | 148 | VAR 149 | bits, weight, maxWeight : CARDINAL; 150 | 151 | BEGIN 152 | bits := 7; 153 | weight := 128; 154 | maxWeight := size DIV 2 + 1; 155 | 156 | WHILE (weight < maxWeight) DO 157 | bits := bits + 8; 158 | weight := weight * 256 159 | END; (* WHILE *) 160 | 161 | RETURN ((bits + 1) > Size.BitsInUse) 162 | END wouldOverflowFileSize; 163 | 164 | 165 | END BasicFileSys. -------------------------------------------------------------------------------- /src/imp/BasicFileSys/BasicFileSys.mw.mod: -------------------------------------------------------------------------------- 1 | (*!m2iso*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE BasicFileSys; (* ModulaWare version *) 4 | 5 | (* Clean file system interface to the junk that comes with ISO *) 6 | 7 | IMPORT ChanConsts, RndFile; (* ISO libraries *) 8 | 9 | IMPORT FileSystem; (* ModulaWare specific library *) 10 | 11 | IMPORT Size; 12 | 13 | 14 | CONST 15 | Opened = ChanConsts.opened; 16 | NotFound = ChanConsts.noSuchFile; 17 | ExistsAlready = ChanConsts.fileExists; 18 | OpenAlready = ChanConsts.alreadyOpen; 19 | 20 | 21 | PROCEDURE fileExists ( path : ARRAY OF CHAR ) : BOOLEAN; 22 | (* Returns TRUE if the file at the given path exists, else FALSE. *) 23 | 24 | VAR 25 | found : BOOLEAN; 26 | f : RndFile.ChanId; 27 | res : RndFile.OpenResults; 28 | 29 | (* The ISO library doesn't provide any file lookup function. So we have 30 | no choice but to open a file just to see if it exists, and if it does 31 | exist then we have to close it again. This is bad design. *) 32 | 33 | BEGIN 34 | (* Why do we need to decide between sequential, stream and random access 35 | when all we want is check if a file exists? Incredibly bad design. *) 36 | 37 | RndFile.OpenOld(f, path, RndFile.read+RndFile.old, res); 38 | 39 | (* There are plenty of failure result codes that do not actually tell us 40 | whether or not the file exists. We have no choice but to deem that it 41 | doesn't exist if any of these failure codes are reported back. 42 | The incompetence in the ISO I/O library design is staggering. *) 43 | found := 44 | (res = Opened) OR 45 | (res = ExistsAlready) OR 46 | (res = OpenAlready); 47 | 48 | IF res = Opened THEN 49 | RndFile.Close(f) 50 | END; (* IF *) 51 | 52 | RETURN found 53 | END fileExists; 54 | 55 | 56 | PROCEDURE GetFileSize 57 | ( path : ARRAY OF CHAR; VAR size : FileSize; VAR status : Status ); 58 | (* Obtains the size of the file at path. On success, the size is passed back 59 | in size and Success is passed back in status. On failure, size remains 60 | unmodified, FileNotFound, SizeOverflow or Failure is passed in status. *) 61 | 62 | (* This procedure requires FilePos arithmetic and conversion which is not 63 | supported by all ISO Modula-2 compilers. For a truly portable but very 64 | inefficient implementation of GetFileSize, see BasicFileSys.p1.mod. *) 65 | 66 | BEGIN 67 | RndFile.OpenOld(f, path, RndFile.read+RndFile.old, res); 68 | 69 | found := 70 | (res = Opened) OR 71 | (res = ExistsAlready) OR 72 | (res = OpenAlready); 73 | 74 | IF NOT found THEN 75 | status := FileNotFound; 76 | RETURN 77 | END; (* IF *) 78 | 79 | IF res # Opened THEN 80 | status := Failure; 81 | RETURN 82 | END; (* IF *) 83 | 84 | fileSize := RndFile.EndPos(f); 85 | RndFile.Close(f); 86 | 87 | IF wouldOverflowFileSize(fileSize) THEN 88 | status := SizeOverflow; 89 | RETURN 90 | END; (* IF *) 91 | 92 | size := VAL(FileSize, fileSize); 93 | status := Success 94 | END GetFileSize; 95 | 96 | 97 | PROCEDURE CreateFile ( path : ARRAY OF CHAR; VAR status : Status ); 98 | (* Creates a new file with the given pathname and passes back status. *) 99 | 100 | VAR 101 | f : StreamFile.ChanId; 102 | res : StreamFile.OpenResults; 103 | 104 | BEGIN 105 | StreamFile.Open(f, path, write, res); 106 | 107 | IF res = Opened THEN 108 | status := Success; 109 | StreamFile.Close(f) 110 | 111 | ELSIF (res = ExistsAlready) OR (res = OpenAlready) THEN 112 | status := FileAlreadyExists 113 | ELSE 114 | status := Failure 115 | END (* IF *) 116 | END CreateFile; 117 | 118 | 119 | PROCEDURE RenameFile ( path, newPath : ARRAY OF CHAR; VAR status : Status ); 120 | (* Renames the file at path to newPath and passes back status. *) 121 | 122 | BEGIN 123 | IF NOT fileExists(path) THEN 124 | status := FileNotFound; 125 | RETURN 126 | END; (* IF *) 127 | 128 | IF fileExists(newPath) THEN 129 | status := FileAlreadyExists; 130 | RETURN 131 | END; (* IF *) 132 | 133 | FileSystem.Rename(path, newPath); (* ModulaWare specific call *) 134 | 135 | IF fileExists(newPath) THEN 136 | status := Success 137 | ELSE 138 | status := Failure 139 | END (* IF *) 140 | END RenameFile; 141 | 142 | 143 | PROCEDURE DeleteFile ( path : ARRAY OF CHAR; VAR status : Status ); 144 | (* Deletes the file at path and passes status in done. *) 145 | 146 | BEGIN 147 | IF NOT fileExists(path) THEN 148 | status := FileNotFound; 149 | RETURN 150 | END; (* IF *) 151 | 152 | FileSystem.Delete(path); (* ModulaWare specific call *) 153 | 154 | IF NOT fileExists(path) THEN 155 | status := Success 156 | ELSE 157 | status := Failure 158 | END (* IF *) 159 | END DeleteFile; 160 | 161 | 162 | (* ************************************************************************ * 163 | * Private Operations * 164 | * ************************************************************************ *) 165 | 166 | (* -------------------------------------------------------------------------- 167 | * function wouldOverflowFileSize(size) 168 | * -------------------------------------------------------------------------- 169 | * Returns TRUE if size > MAX(FileSize), else FALSE. 170 | * ----------------------------------------------------------------------- *) 171 | 172 | PROCEDURE wouldOverflowFileSize ( size : RndFile.FilePos ) : BOOLEAN; 173 | 174 | VAR 175 | bits : CARDINAL; 176 | weight, maxWeight : RndFile.FilePos; 177 | 178 | BEGIN 179 | bits := 0; 180 | weight := 1; 181 | maxWeight := size DIV 2 + 1; 182 | 183 | (* calculate required bits *) 184 | WHILE weight < maxWeight DO 185 | bits := bits + 1; 186 | weight := weight * 2 187 | END; (* WHILE *) 188 | 189 | RETURN ((bits + 1) > Size.BitsInUse) 190 | END wouldOverflowFileSize; 191 | 192 | 193 | END BasicFileSys. -------------------------------------------------------------------------------- /src/imp/BasicFileSys/BasicFileSys.p1.mod: -------------------------------------------------------------------------------- 1 | (*!m2iso+p1*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE BasicFileSys; (* p1 version *) 4 | 5 | (* Clean file system interface to the junk that comes with ISO *) 6 | 7 | IMPORT ChanConsts, IOResult, RawIO, RndFile; (* ISO libraries *) 8 | 9 | FROM stdio IMPORT INT, rename, remove; 10 | 11 | 12 | CONST 13 | Opened = ChanConsts.opened; 14 | NotFound = ChanConsts.noSuchFile; 15 | ExistsAlready = ChanConsts.fileExists; 16 | OpenAlready = ChanConsts.alreadyOpen; 17 | 18 | 19 | PROCEDURE fileExists ( path : ARRAY OF CHAR ) : BOOLEAN; 20 | (* Returns TRUE if the file at the given path exists, else FALSE. *) 21 | 22 | VAR 23 | found : BOOLEAN; 24 | f : RndFile.ChanId; 25 | res : RndFile.OpenResults; 26 | 27 | (* The ISO library doesn't provide any file lookup function. So we have 28 | no choice but to open a file just to see if it exists, and if it does 29 | exist then we have to close it again. This is bad design. *) 30 | 31 | BEGIN 32 | (* Why do we need to decide between sequential, stream and random access 33 | when all we want is check if a file exists? Incredibly bad design. *) 34 | 35 | RndFile.OpenOld(f, path, RndFile.read+RndFile.old, res); 36 | 37 | (* There are plenty of failure result codes that do not actually tell us 38 | whether or not the file exists. We have no choice but to deem that it 39 | doesn't exist if any of these failure codes are reported back. 40 | The incompetence in the ISO I/O library design is staggering. *) 41 | found := 42 | (res = Opened) OR 43 | (res = ExistsAlready) OR 44 | (res = OpenAlready); 45 | 46 | IF res = Opened THEN 47 | RndFile.Close(f) 48 | END; (* IF *) 49 | 50 | RETURN found 51 | END fileExists; 52 | 53 | 54 | PROCEDURE GetFileSize 55 | ( path : ARRAY OF CHAR; VAR size : FileSize; VAR status : Status ); 56 | (* Obtains the size of the file at path. On success, the size is passed back 57 | in size and Success is passed back in status. On failure, size remains 58 | unmodified, FileNotFound, SizeOverflow or Failure is passed in status. *) 59 | 60 | VAR 61 | ch : CHAR; 62 | found : BOOLEAN; 63 | f : RndFile.ChanId; 64 | counter : FileSize; 65 | res : RndFile.OpenResults; 66 | 67 | (* The p1 compiler does not permit any arithmetic on values of type FilePos 68 | nor does it permit conversion to another type. As ridiculous as this may 69 | seem, it does not violate the ISO standard which defines type FilePos as 70 | an array and does not require it to support arithmetic nor conversion. 71 | We therefore have no choice but to open the file, read it byte by byte 72 | to the end while incrementing a counter to obtain the filesize as a 73 | value of a useful type. This is terribly inefficiant, especially on 74 | larger files. The penalty for using such a badly designed standard. *) 75 | 76 | BEGIN 77 | RndFile.OpenOld(f, path, RndFile.read+RndFile.old, res); 78 | 79 | found := 80 | (res = Opened) OR 81 | (res = ExistsAlready) OR 82 | (res = OpenAlready); 83 | 84 | IF NOT found THEN 85 | status := FileNotFound; 86 | RETURN 87 | END; (* IF *) 88 | 89 | IF res # Opened THEN 90 | status := Failure; 91 | RETURN 92 | END; (* IF *) 93 | 94 | counter := 0; 95 | WHILE IOResult.ReadResult(f) # IOResult.endOfInput DO 96 | RawIO.Read(f, ch); 97 | 98 | IF counter = MAX(FileSize) THEN 99 | status := SizeOverflow; 100 | RndFile.Close(f); 101 | RETURN 102 | END; (* IF *) 103 | 104 | counter := counter + 1 105 | END; (* WHILE *) 106 | 107 | RndFile.Close(f); 108 | status := Success; 109 | size := counter 110 | END GetFileSize; 111 | 112 | 113 | PROCEDURE CreateFile ( path : ARRAY OF CHAR; VAR status : Status ); 114 | (* Creates a new file with the given pathname and passes back status. *) 115 | 116 | VAR 117 | f : RndFile.ChanId; 118 | res : RndFile.OpenResults; 119 | 120 | BEGIN 121 | RndFile.OpenClean(f, path, RndFile.write, res); 122 | 123 | IF res = Opened THEN 124 | status := Success; 125 | RndFile.Close(f) 126 | 127 | ELSIF (res = ExistsAlready) OR (res = OpenAlready) THEN 128 | status := FileAlreadyExists 129 | ELSE 130 | status := Failure 131 | END (* IF *) 132 | END CreateFile; 133 | 134 | 135 | PROCEDURE RenameFile ( path, newPath : ARRAY OF CHAR; VAR status : Status ); 136 | (* Renames the file at path to newPath and passes back status. *) 137 | 138 | VAR 139 | res : INT; 140 | 141 | BEGIN 142 | IF NOT fileExists(path) THEN 143 | status := FileNotFound; 144 | RETURN 145 | END; (* IF *) 146 | 147 | IF fileExists(newPath) THEN 148 | status := FileAlreadyExists; 149 | RETURN 150 | END; (* IF *) 151 | 152 | res := rename(path, newPath); (* foreign call *) 153 | 154 | IF res = 0 THEN 155 | status := Success 156 | ELSE 157 | status := Failure 158 | END (* IF *) 159 | END RenameFile; 160 | 161 | 162 | PROCEDURE DeleteFile ( path : ARRAY OF CHAR; VAR status : Status ); 163 | (* Deletes the file at path and passes status in done. *) 164 | 165 | VAR 166 | res : INT; 167 | 168 | BEGIN 169 | IF NOT fileExists(path) THEN 170 | status := FileNotFound; 171 | RETURN 172 | END; (* IF *) 173 | 174 | res := remove(path); (* foreign call *) 175 | 176 | IF res = 0 THEN 177 | status := Success 178 | ELSE 179 | status := Failure 180 | END (* IF *) 181 | END DeleteFile; 182 | 183 | 184 | END BasicFileSys. -------------------------------------------------------------------------------- /src/imp/BasicFileSys/BasicFileSys.pim.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE BasicFileSys; (* PIM version *) 4 | 5 | (* Clean file system interface to the junk that came with PIM *) 6 | 7 | IMPORT FileSystem; (* PIM's junk library *) 8 | 9 | IMPORT Size; 10 | 11 | 12 | PROCEDURE fileExists ( path : ARRAY OF CHAR ) : BOOLEAN; 13 | (* Returns TRUE if the file at the given path exists, else FALSE. *) 14 | 15 | VAR 16 | found : BOOLEAN; 17 | f : FileSystem.File; 18 | 19 | (* The PIM library doesn't actually have a file lookup function. It 20 | mislabels the open file function as lookup instead. So we have no 21 | choice but to open a file just to see if it exists, and if it does 22 | exist then we have to close it again. Bad design. *) 23 | 24 | BEGIN 25 | FileSystem.Lookup(f, path, false); 26 | found := (f.res = FileSystem.done); 27 | 28 | IF FileSystem.opened IN f.flags THEN 29 | FileSystem.Close(f) 30 | END; (* IF *) 31 | 32 | RETURN found 33 | END fileExists; 34 | 35 | 36 | PROCEDURE GetFileSize 37 | ( path : ARRAY OF CHAR; VAR size : FileSize; VAR status : Status ); 38 | (* Obtains the size of the file at path. On success, the size is passed back 39 | in size and Success is passed back in status. On failure, size remains 40 | unmodified, FileNotFound, SizeOverflow or Failure is passed in status. *) 41 | 42 | VAR 43 | found : BOOLEAN; 44 | f : FileSystem.File; 45 | high, low : CARDINAL; 46 | highFactor, highWeight : FileSize; 47 | 48 | BEGIN 49 | FileSystem.Lookup(f, path, false); 50 | found := (f.res = FileSystem.done); 51 | 52 | IF NOT found THEN 53 | status := FileNotFound; 54 | RETURN 55 | END; (* IF *) 56 | 57 | IF FileSystem.opened IN f.flags THEN 58 | FileSystem.Length(f, high, low); 59 | FileSystem.Close(f) 60 | ELSE 61 | status := Failure; 62 | RETURN 63 | END (* IF *) 64 | 65 | IF high = 0 THEN 66 | IF wouldOverflowFileSize(low) THEN 67 | status := SizeOverflow; 68 | RETURN 69 | ELSE 70 | size := VAL(FileSize, low) 71 | END (* IF *) 72 | 73 | ELSE (* high > 0 *) 74 | IF MAX(FileSize) <= MAX(CARDINAL) THEN 75 | status := SizeOverflow; 76 | RETURN 77 | END; (* IF *) 78 | 79 | (* highFactor := 2^(bitwidth of CARDINAL) *) 80 | highFactor := VAL(FileSize, MAX(CARDINAL)) + 1; 81 | IF mulWouldOverflowFS(high, highFactor) THEN 82 | status := SizeOverflow; 83 | RETURN 84 | END; (* IF *) 85 | 86 | (* highWeight := high * 2^(bitwidth of CARDINAL) *) 87 | highWeight := VAL(FileSize, high) * highFactor; 88 | IF addWouldOverflowFS(highWeight, low) THEN 89 | status := SizeOverflow; 90 | RETURN 91 | END; (* IF *) 92 | 93 | (* size := high * 2^(bitwidth of CARDINAL) + low *) 94 | size := highWeight + VAL(FileSize, low) 95 | END; (* IF *) 96 | 97 | status := Success 98 | END GetFileSize; 99 | 100 | 101 | PROCEDURE CreateFile ( path : ARRAY OF CHAR; VAR status : Status ); 102 | (* Creates a new file with the given pathname and passes back status. *) 103 | 104 | VAR 105 | f : FileSystem.File; 106 | 107 | BEGIN 108 | IF fileExists(path) THEN 109 | status := FileAlreadyExists; 110 | RETURN 111 | END; (* IF *) 112 | 113 | FileSystem.Create(f); 114 | IF f.res # FileSystem.done THEN 115 | status := Failure; 116 | RETURN 117 | END; (* IF *) 118 | 119 | FileSystem.Rename(f, path); 120 | IF f.res # FileSystem.done THEN 121 | status := Failure; 122 | RETURN 123 | END; (* IF *) 124 | 125 | (* see if the file has been opened and if so close it, just in case *) 126 | IF FileSystem.opened IN f.flags THEN 127 | FileSystem.Close(f) 128 | END (* IF *) 129 | END CreateFile; 130 | 131 | 132 | PROCEDURE RenameFile ( path, newPath : ARRAY OF CHAR; VAR status : Status ); 133 | (* Renames the file at path to newPath and passes back status. *) 134 | 135 | VAR 136 | f : FileSystem.File; 137 | 138 | BEGIN 139 | IF NOT fileExists(path) THEN 140 | status := FileNotFound; 141 | RETURN 142 | END; (* IF *) 143 | 144 | IF fileExists(newPath) THEN 145 | status := FileAlreadyExists; 146 | RETURN 147 | END; (* IF *) 148 | 149 | FileSystem.Lookup(f, path, false); 150 | FileSystem.Rename(f, path); 151 | 152 | IF f.res = FileSystem.done THEN 153 | status := Success 154 | ELSE 155 | status := Failure 156 | END; (* IF *) 157 | 158 | IF FileSystem.opened IN f.flags THEN 159 | FileSystem.Close(f) 160 | END (* IF *) 161 | END RenameFile; 162 | 163 | 164 | PROCEDURE DeleteFile ( path : ARRAY OF CHAR; VAR status : Status ); 165 | (* Deletes the file at path and passes status in done. *) 166 | 167 | VAR 168 | f : FileSystem.File; 169 | 170 | BEGIN 171 | IF NOT fileExists(path) THEN 172 | status := FileNotFound; 173 | RETURN 174 | END; (* IF *) 175 | 176 | FileSystem.Delete(path, f); 177 | 178 | IF f.res = FileSystem.done THEN 179 | status := Success 180 | ELSE 181 | status := Failure 182 | END (* IF *) 183 | END DeleteFile; 184 | 185 | 186 | (* ************************************************************************ * 187 | * Private Operations * 188 | * ************************************************************************ *) 189 | 190 | PROCEDURE wouldOverflowFileSize ( n : CARDINAL ) : BOOLEAN; 191 | 192 | BEGIN 193 | IF MAX(FileSize) > MAX(CARDINAL) THEN 194 | RETURN FALSE 195 | ELSE 196 | RETURN n > MAX(FileSize) 197 | END (* IF *) 198 | END wouldOverflowFileSize; 199 | 200 | 201 | PROCEDURE addWouldOverflowFS ( n, m : CARDINAL ) : BOOLEAN; 202 | 203 | BEGIN 204 | IF valueWouldOverflowFS(n) THEN 205 | RETURN TRUE 206 | ELSIF valueWouldOverflowFS(m) THEN 207 | RETURN TRUE 208 | ELSE 209 | RETURN (MAX(FileSize) - m) < n 210 | END (* IF *) 211 | END addWouldOverflowFS; 212 | 213 | 214 | PROCEDURE mulWouldOverflowFS ( n, m : CARDINAL ) : BOOLEAN; 215 | 216 | BEGIN 217 | IF m > 0 THEN 218 | RETURN ((MAX(FileSize) DIV m) < n) 219 | ELSE 220 | RETURN FALSE 221 | END (* IF *) 222 | END mulWouldOverflowFS; 223 | 224 | 225 | END BasicFileSys. -------------------------------------------------------------------------------- /src/imp/BasicFileSys/BasicFileSys.posix.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE BasicFileSys; (* POSIX version *) 4 | 5 | (* Clean file system interface based on POSIX, 6 | not using any of the junk that comes with PIM and ISO *) 7 | 8 | FROM stat IMPORT Stat, stat; 9 | FROM stdio IMPORT INT, rename, remove; 10 | FROM unistd IMPORT FileOK, CreateOnly, access, unlink; 11 | 12 | 13 | PROCEDURE fileExists ( path : ARRAY OF CHAR ) : BOOLEAN; 14 | (* Returns TRUE if the file at the given path exists, else FALSE. *) 15 | 16 | BEGIN 17 | RETURN (access(path, FileOK) = 0) 18 | END fileExists; 19 | 20 | 21 | PROCEDURE GetFileSize 22 | ( path : ARRAY OF CHAR; VAR size : FileSize; VAR status : Status ); 23 | (* Obtains the size of the file at path. On success, the size is passed back 24 | in size and Success is passed back in status. On failure, size remains 25 | unmodified, FileNotFound, SizeOverflow or Failure is passed in status. *) 26 | 27 | VAR 28 | res : INT; 29 | st : Stat; 30 | 31 | BEGIN 32 | IF access(path, FileOK) # 0 THEN 33 | status := FileNotFound; 34 | RETURN 35 | END; (* IF *) 36 | 37 | res := stat(path, st); 38 | 39 | IF res # -1 THEN 40 | size := st.size; 41 | status := Success 42 | ELSE 43 | status := Failure 44 | END (* IF *) 45 | END GetFileSize; 46 | 47 | 48 | PROCEDURE CreateFile ( path : ARRAY OF CHAR; VAR status : Status ); 49 | (* Creates a new file with the given pathname and passes back status. *) 50 | 51 | VAR 52 | res : INT; 53 | 54 | BEGIN 55 | IF access(path) # 0 THEN 56 | status := FileNotFound; 57 | RETURN 58 | END; (* IF *) 59 | 60 | res := open(path, CreateOnly); 61 | 62 | IF res # -1 THEN 63 | status := Success; 64 | ELSE 65 | status := Failure 66 | END (* IF *) 67 | END CreateFile; 68 | 69 | 70 | PROCEDURE RenameFile ( path, newPath : ARRAY OF CHAR; VAR status : Status ); 71 | (* Renames the file at path to newPath and passes back status. *) 72 | 73 | VAR 74 | res : INT; 75 | 76 | BEGIN 77 | IF access(path, FileOK) # 0 THEN 78 | status := FileNotFound; 79 | RETURN 80 | END; (* IF *) 81 | 82 | res := rename(path, newPath); 83 | 84 | IF res = 0 THEN 85 | status := Success 86 | ELSE 87 | status := Failure 88 | END (* IF *) 89 | END RenameFile; 90 | 91 | 92 | PROCEDURE DeleteFile ( path : ARRAY OF CHAR; VAR status : Status ); 93 | (* Deletes the file at path and passes status in done. *) 94 | 95 | VAR 96 | res : INT; 97 | 98 | BEGIN 99 | IF access(path, FileOK) # 0 THEN 100 | status := FileNotFound; 101 | RETURN 102 | END; (* IF *) 103 | 104 | res := unlink(path); 105 | 106 | IF res = 0 THEN 107 | status := Success 108 | ELSE 109 | status := Failure 110 | END (* IF *) 111 | END DeleteFile; 112 | 113 | 114 | END BasicFileSys. -------------------------------------------------------------------------------- /src/imp/BasicFileSys/BasicFileSys.ulm.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE BasicFileSys; (* Ulm version *) 4 | 5 | (* Basic Filesystem interface for M2PP and M2BSK *) 6 | 7 | IMPORT SystemTypes, SysAccess, SysStat, Files; (* Ulm specific libraries *) 8 | 9 | IMPORT Size; 10 | 11 | FROM stdio IMPORT INT, rename, remove; 12 | FROM unistd IMPORT FileOK, CreateOnly, access, unlink; 13 | 14 | 15 | PROCEDURE fileExists ( path : ARRAY OF CHAR ) : BOOLEAN; 16 | (* Returns TRUE if the file at the given path exists, else FALSE. *) 17 | 18 | BEGIN 19 | RETURN SysAccess.Access(path, 0) 20 | END fileExists; 21 | 22 | 23 | PROCEDURE GetFileSize 24 | ( path : ARRAY OF CHAR; VAR size : FileSize; VAR status : Status ); 25 | (* Obtains the size of the file at path. On success, the size is passed back 26 | in size and Success is passed back in status. On failure, size remains 27 | unmodified, FileNotFound, SizeOverflow or Failure is passed in status. *) 28 | 29 | VAR 30 | done : BOOLEAN; 31 | stat : SysStat.StatBuf; 32 | 33 | BEGIN 34 | IF NOT fileExists(path) THEN 35 | status := FileNotFound; 36 | RETURN 37 | END; (* IF *) 38 | 39 | done := SysStat.Stat(path, stat); 40 | 41 | IF NOT done THEN 42 | status := Failure; 43 | RETURN 44 | END; (* IF *) 45 | 46 | IF wouldOverflowFileSize(stat.size) THEN 47 | status := SizeOverflow; 48 | RETURN 49 | END; (* IF *) 50 | 51 | size := VAL(FileSize, stat.size); 52 | status := Success 53 | END GetFileSize; 54 | 55 | 56 | PROCEDURE CreateFile ( path : ARRAY OF CHAR; VAR status : Status ); 57 | (* Creates a new file with the given pathname and passes back status. *) 58 | 59 | VAR 60 | f : StdIO.File; 61 | 62 | BEGIN 63 | IF fileExists(path) THEN 64 | status := FileAlreadyExists; 65 | RETURN 66 | END; (* IF *) 67 | 68 | done := StdIO.Fopen(f, path, StdIO.write, FALSE); 69 | 70 | IF done THEN 71 | done := StdIO.Fclose(f); 72 | 73 | IF done THEN 74 | status := Success 75 | ELSE 76 | status := Failure 77 | END (* IF *) 78 | ELSE 79 | status := Failure 80 | END (* IF *) 81 | END CreateFile; 82 | 83 | 84 | PROCEDURE RenameFile ( path, newPath : ARRAY OF CHAR; VAR status : Status ); 85 | (* Renames the file at path to newPath and passes back status. *) 86 | 87 | VAR 88 | res : INT; 89 | 90 | BEGIN 91 | IF NOT fileExists(path) THEN 92 | status := FileNotFound; 93 | RETURN 94 | END; (* IF *) 95 | 96 | IF fileExists(newPath) THEN 97 | status := FileAlreadyExists; 98 | RETURN 99 | END; (* IF *) 100 | 101 | Files.Remame(path, newPath); 102 | 103 | IF fileExists(newPath) AND NOT fileExists(path) THEN 104 | status := Success 105 | ELSE 106 | status := Failure 107 | END (* IF *) 108 | END RenameFile; 109 | 110 | 111 | PROCEDURE DeleteFile ( path : ARRAY OF CHAR; VAR status : Status ); 112 | (* Deletes the file at path and passes status in done. *) 113 | 114 | VAR 115 | res : INT; 116 | 117 | BEGIN 118 | IF NOT fileExists(path) THEN 119 | status := FileNotFound; 120 | RETURN 121 | END; (* IF *) 122 | 123 | Files.Delete(path); 124 | 125 | IF fileExists(path) THEN 126 | status := Failure 127 | ELSE 128 | status := Success 129 | END (* IF *) 130 | END DeleteFile; 131 | 132 | 133 | (* ************************************************************************ * 134 | * Private Operations * 135 | * ************************************************************************ *) 136 | 137 | (* -------------------------------------------------------------------------- 138 | * function wouldOverflowFileSize(size) 139 | * -------------------------------------------------------------------------- 140 | * Returns TRUE if size > MAX(FileSize), else FALSE. 141 | * ----------------------------------------------------------------------- *) 142 | 143 | PROCEDURE wouldOverflowFileSize ( size : SystemTypes.OFF ) : BOOLEAN; 144 | 145 | VAR 146 | bits : CARDINAL; 147 | weight, maxWeight : SystemTypes.OFF; 148 | 149 | BEGIN 150 | bits := 0; 151 | weight := 1; 152 | maxWeight := size DIV 2 + 1; 153 | 154 | (* calculate required bits *) 155 | WHILE weight < maxWeight DO 156 | bits := bits + 1; 157 | weight := weight * 2 158 | END; (* WHILE *) 159 | 160 | RETURN ((bits + 1) > Size.BitsInUse) 161 | END wouldOverflowFileSize; 162 | 163 | 164 | END BasicFileSys. -------------------------------------------------------------------------------- /src/imp/BasicFileSys/BasicFileSys.xds.mod: -------------------------------------------------------------------------------- 1 | (*!m2iso*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE BasicFileSys; (* XDS version *) 4 | 5 | (* Clean file system interface to the junk that comes with ISO *) 6 | 7 | IMPORT ChanConsts, RndFile; (* ISO libraries *) 8 | 9 | IMPORT FileSys; (* XDS specific library *) 10 | 11 | IMPORT Size; 12 | 13 | 14 | CONST 15 | Opened = ChanConsts.opened; 16 | NotFound = ChanConsts.noSuchFile; 17 | ExistsAlready = ChanConsts.fileExists; 18 | OpenAlready = ChanConsts.alreadyOpen; 19 | 20 | 21 | PROCEDURE fileExists ( path : ARRAY OF CHAR ) : BOOLEAN; 22 | (* Returns TRUE if the file at the given path exists, else FALSE. *) 23 | 24 | BEGIN 25 | RETURN FileSys.Exists(path) 26 | END fileExists; 27 | 28 | 29 | PROCEDURE GetFileSize 30 | ( path : ARRAY OF CHAR; VAR size : FileSize; VAR status : Status ); 31 | (* Obtains the size of the file at path. On success, the size is passed back 32 | in size and Success is passed back in status. On failure, size remains 33 | unmodified, FileNotFound, SizeOverflow or Failure is passed in status. *) 34 | 35 | (* This procedure requires FilePos arithmetic and conversion which is not 36 | supported by all ISO Modula-2 compilers. For a truly portable but very 37 | inefficient implementation of GetFileSize, see BasicFileSys.p1.mod. *) 38 | 39 | BEGIN 40 | RndFile.OpenOld(f, path, RndFile.read+RndFile.old, res); 41 | 42 | found := 43 | (res = Opened) OR 44 | (res = ExistsAlready) OR 45 | (res = OpenAlready); 46 | 47 | IF NOT found THEN 48 | status := FileNotFound; 49 | RETURN 50 | END; (* IF *) 51 | 52 | IF res # Opened THEN 53 | status := Failure; 54 | RETURN 55 | END; (* IF *) 56 | 57 | fileSize := RndFile.EndPos(f); 58 | RndFile.Close(f); 59 | 60 | IF wouldOverflowFileSize(fileSize) THEN 61 | status := SizeOverflow; 62 | RETURN 63 | END; (* IF *) 64 | 65 | size := VAL(FileSize, fileSize); 66 | status := Success 67 | END GetFileSize; 68 | 69 | 70 | PROCEDURE CreateFile ( path : ARRAY OF CHAR; VAR status : Status ); 71 | (* Creates a new file with the given pathname and passes back status. *) 72 | 73 | VAR 74 | f : StreamFile.ChanId; 75 | res : StreamFile.OpenResults; 76 | 77 | BEGIN 78 | StreamFile.Open(f, path, write, res); 79 | 80 | IF res = Opened THEN 81 | status := Success; 82 | StreamFile.Close(f) 83 | 84 | ELSIF (res = ExistsAlready) OR (res = OpenAlready) THEN 85 | status := FileAlreadyExists 86 | ELSE 87 | status := Failure 88 | END (* IF *) 89 | END CreateFile; 90 | 91 | 92 | PROCEDURE RenameFile ( path, newPath : ARRAY OF CHAR; VAR status : Status ); 93 | (* Renames the file at path to newPath and passes back status. *) 94 | 95 | VAR 96 | done : BOOLEAN; 97 | 98 | BEGIN 99 | IF NOT fileExists(path) THEN 100 | status := FileNotFound; 101 | RETURN 102 | END; (* IF *) 103 | 104 | IF fileExists(newPath) THEN 105 | status := FileAlreadyExists; 106 | RETURN 107 | END; (* IF *) 108 | 109 | FileSys.Rename(path, newPath, done); (* XDS specific call *) 110 | 111 | IF done THEN 112 | status := Success 113 | ELSE 114 | status := Failure 115 | END (* IF *) 116 | END RenameFile; 117 | 118 | 119 | PROCEDURE DeleteFile ( path : ARRAY OF CHAR; VAR status : Status ); 120 | (* Deletes the file at path and passes status in done. *) 121 | 122 | VAR 123 | done : BOOLEAN; 124 | 125 | BEGIN 126 | IF NOT fileExists(path) THEN 127 | status := FileNotFound; 128 | RETURN 129 | END; (* IF *) 130 | 131 | FileSys.Remove(path, done); (* XDS specific call *) 132 | 133 | IF done THEN 134 | status := Success 135 | ELSE 136 | status := Failure 137 | END (* IF *) 138 | END DeleteFile; 139 | 140 | 141 | (* ************************************************************************ * 142 | * Private Operations * 143 | * ************************************************************************ *) 144 | 145 | (* -------------------------------------------------------------------------- 146 | * function wouldOverflowFileSize(size) 147 | * -------------------------------------------------------------------------- 148 | * Returns TRUE if size > MAX(FileSize), else FALSE. 149 | * ----------------------------------------------------------------------- *) 150 | 151 | PROCEDURE wouldOverflowFileSize ( size : RndFile.FilePos ) : BOOLEAN; 152 | 153 | VAR 154 | bits : CARDINAL; 155 | weight, maxWeight : RndFile.FilePos; 156 | 157 | BEGIN 158 | bits := 0; 159 | weight := 1; 160 | maxWeight := size DIV 2 + 1; 161 | 162 | (* calculate required bits *) 163 | WHILE weight < maxWeight DO 164 | bits := bits + 1; 165 | weight := weight * 2 166 | END; (* WHILE *) 167 | 168 | RETURN ((bits + 1) > Size.BitsInUse) 169 | END wouldOverflowFileSize; 170 | 171 | 172 | END BasicFileSys. -------------------------------------------------------------------------------- /src/imp/M2PP.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | MODULE M2PP; 4 | 5 | (* Modula-2 Preprocessor Driver *) 6 | 7 | IMPORT 8 | Args, ArgParser, BuildInfo, BuildParams, 9 | FNStr, Infile, Outfile, Preprocessor; 10 | 11 | FROM BasicFileSys IMPORT fileExists, RenameFile; 12 | FROM Infile IMPORT InfileT; (* alias for Infile.Infile *) 13 | FROM Outfile IMPORT OutfileT; (* alias for Outfile.Outfile *) 14 | 15 | 16 | CONST 17 | ProgTitle = "M2PP - Modula-2 Preprocessor"; 18 | Version = "Version 0.1.0\n"; 19 | Copyright = "Copyright (c) 2017 Modula-2 Software Foundation\n"; 20 | License = "Licensed under the LGPL license version 2.1\n"; 21 | 22 | 23 | PROCEDURE PrintBanner; 24 | 25 | BEGIN 26 | Console.WriteChars(ProgTitle); Console.WriteChars(", "); 27 | Console.WriteChars(Version); 28 | Console.WriteChars(Copyright) 29 | END PrintBanner; 30 | 31 | 32 | PROCEDURE PrintUsage; 33 | 34 | BEGIN 35 | Console.WriteChars("Usage:\n"); 36 | Console.WriteChars("$ m2pp infoRequest\n"); Console.WriteChars("or\n"); 37 | Console.WriteChars("$ m2pp sourceFile option* diagnostic*\n\n"); 38 | 39 | Console.WriteChars("infoRequest:\n"); 40 | Console.WriteChars(" --help, -h : print help\n"); 41 | Console.WriteChars(" --version, -V : print version\n"); 42 | Console.WriteChars(" --license : print license info\n"); 43 | Console.WriteChars(" --build-info : print build configuration\n\n"); 44 | 45 | Console.WriteChars("option:\n"); 46 | Console.WriteChars(" --outfile targetFile : define outfile\n"); 47 | Console.WriteChars(" --dict keyValuePair+ : define key/value pairs\n"); 48 | Console.WriteChars(" --tabwidth number : set tab width\n"); 49 | Console.WriteChars(" --newline mode : set newline mode\n\n"); 50 | 51 | Console.WriteChars("diagnostic:\n"); 52 | Console.WriteChars(" --verbose, -v : verbose output\n"); 53 | Console.WriteChars(" --show-settings : print all settings\n\n"); 54 | 55 | Console.WriteChars("keyValuePair:\n"); 56 | Console.WriteChars(" key=value\n\n"); 57 | 58 | Console.WriteChars("key:\n"); 59 | Console.WriteChars(" identifier\n\n"); 60 | 61 | Console.WriteChars("value:\n"); 62 | Console.WriteChars 63 | (" identifier | number | singleQuotedString | doubleQuotedString\n\n"); 64 | 65 | Console.WriteChars("mode:\n"); 66 | Console.WriteChars(" cr | lf | crlf\n\n") 67 | END PrintUsage; 68 | 69 | 70 | PROCEDURE PrintBuildInfo; 71 | 72 | BEGIN 73 | Console.WriteChars("Built on : "); 74 | Console.WriteChars(BuildInfo.Platform); 75 | Console.WriteChars("\nDialect : "); 76 | Console.WriteChars(BuildInfo.Dialect); 77 | Console.WriteChars("\nCompiler : "); 78 | Console.WriteChars(BuildInfo.Compiler); 79 | Console.WriteChars("\nI/O library : "); 80 | Console.WriteChars(BuildInfo.IOLibrary); 81 | Console.WriteChars("\nMemory Model: "); 82 | Console.WriteChars(BuildInfo.MemModel); 83 | Console.WriteLn 84 | END PrintBuildInfo; 85 | 86 | 87 | PROCEDURE PreflightCheck 88 | ( VAR infile : InfileT; VAR outfile : OutfileT; VAR passed : BOOLEAN ); 89 | 90 | VAR 91 | len : CARDINAL; 92 | pathStr : StringT; 93 | status : BasicFileIO.Status; 94 | path : ARRAY [0..BuildParams.MaxPathLen] OF CHAR; 95 | 96 | BEGIN 97 | pathStr := Settings.infile(); 98 | String.CopyToArray(pathStr, path, len); 99 | 100 | IF len = 0 THEN 101 | Console.WriteChars("source path too long.\n"); 102 | passed := FALSE; 103 | RETURN 104 | END; (* IF *) 105 | 106 | (* bail out if infile does not exist *) 107 | IF NOT fileExists(path) THEN 108 | Console.WriteChars("sourcefile not found.\n"); 109 | passed := FALSE; 110 | RETURN 111 | END; (* IF *) 112 | 113 | Infile.Open(infile, status); 114 | 115 | IF status # Success THEN 116 | Console.WriteChars("unable to open sourcefile.\n"); 117 | infile := Infile.Nil; 118 | passed := FALSE; 119 | RETURN 120 | END; (* IF *) 121 | 122 | IF NOT Settings.alreadySet(Settings.Outfile) THEN 123 | (* derive target name from source name *) 124 | pathStr := FNStr.targetName(pathStr) 125 | ELSE 126 | pathStr := Settings.outfile() 127 | END; (* IF *) 128 | 129 | String.CopyToArray(pathStr, path, len); 130 | 131 | IF len = 0 THEN 132 | Console.WriteChars("target path too long.\n"); 133 | passed := FALSE; 134 | RETURN 135 | END; (* IF *) 136 | 137 | IF fileExists(path) THEN 138 | (* rename existing file *) 139 | END; (* IF *) 140 | 141 | Outfile.Open(outfile, status); 142 | 143 | IF status # Success THEN 144 | Console.WriteChars("unable to create targetfile.\n"); 145 | Infile.Close(infile); 146 | infile := Infile.Nil; 147 | outfile := Outfile.Nil; 148 | passed := FALSE; 149 | RETURN 150 | END; (* IF *) 151 | 152 | (* all preflight checks passed *) 153 | passed := TRUE; 154 | END PreflightCheck; 155 | 156 | 157 | VAR 158 | passed : BOOLEAN; 159 | infile : InfileT; 160 | outfile : OutfileT; 161 | argStatus : ArgParser.Status; 162 | fsStatus : BasicFileSys.Status; 163 | 164 | 165 | BEGIN (* M2PP *) 166 | (* check if program argument file is present *) 167 | IF fileExists(Args.Filename) THEN 168 | Args.Open 169 | ELSE (* query user and write file *) 170 | Args.Query 171 | END; (* IF *) 172 | 173 | argStatus := ArgParser.parseArgs(); 174 | Args.Close; 175 | Args.Delete; 176 | 177 | CASE argStatus OF 178 | Success : 179 | PrintBanner; 180 | 181 | PreflightCheck(infile, outfile, passed); 182 | 183 | IF passed THEN 184 | Preprocessor.Expand(infile, outfile); 185 | Infile.Close(infile); 186 | Outfile.Close(outfile) 187 | ELSE 188 | (* unable to proceed *) 189 | END (* IF *) 190 | 191 | | HelpRequested : 192 | PrintUsage 193 | 194 | | VersionRequested : 195 | Console.WriteChars(Version) 196 | 197 | | LicenseRequested : 198 | Console.WriteChars(Copyright); 199 | Console.WriteChars(License) 200 | 201 | | BuildInfoRequested : 202 | PrintBuildInfo 203 | 204 | | ErrorsEncountered : 205 | (* TO DO *) 206 | END (* CASE *) 207 | END M2PP. -------------------------------------------------------------------------------- /src/imp/Newline.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE Newline; 4 | 5 | (* Newline mode management *) 6 | 7 | VAR defaultMode : Mode; 8 | 9 | 10 | PROCEDURE SetMode ( mode : Mode ); 11 | (* Sets the newline mode. *) 12 | 13 | BEGIN 14 | defaultMode := mode 15 | END SetMode; 16 | 17 | 18 | PROCEDURE mode ( ) : Mode; 19 | (* Returns the newline mode. *) 20 | 21 | BEGIN 22 | RETURN defaultMode; 23 | END mode; 24 | 25 | 26 | BEGIN 27 | defaultMode := Default 28 | END Newline. -------------------------------------------------------------------------------- /src/imp/NumStr.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE NumStr; 4 | 5 | (* Numeric String Conversion Library *) 6 | 7 | IMPORT String; 8 | FROM String IMPORT StringT; (* alias for String.String *) 9 | 10 | 11 | PROCEDURE ToCard 12 | ( numStr : StringT; VAR value : CARDINAL; VAR status : Status ); 13 | (* Converts the value represented by numStr to type CARDINAL. *) 14 | 15 | VAR 16 | ch : CHAR; 17 | overflow : BOOLEAN; 18 | index, minIndex, digitIndex, 19 | accumulator, digitWeight, digitValue : CARDINAL; 20 | 21 | BEGIN 22 | (* check sign *) 23 | ch := String.charAtIndex(numStr, 0); 24 | minIndex := 0; 25 | IF ch = '+' THEN 26 | minIndex := 1 27 | ELSIF ch = '-' THEN 28 | status := Underflow; 29 | RETURN 30 | END; (* IF *) 31 | 32 | (* get the index for the right most character *) 33 | digitIndex := String.length(numStr); 34 | IF digitIndex > 0 THEN 35 | digitIndex := digitIndex - 1 36 | END; (* IF *) 37 | 38 | accumulator := 0; 39 | digitWeight := 1; 40 | 41 | (* iterate over all chars from right to left *) 42 | LOOP 43 | (* verify character is a digit *) 44 | ch := String.charAtIndex(numStr, digitIndex); 45 | IF (ch >= '0') AND (ch <= '9') THEN 46 | digitValue := digitWeight * (ORD(ch) - ORD("0")) 47 | ELSE (* not a number *) 48 | status := NaN; 49 | RETURN 50 | END; (* IF *) 51 | 52 | (* add this digit's value to accumulator *) 53 | addCard(accumulator, digitValue, overflow); 54 | IF overflow THEN 55 | status := Overflow; 56 | RETURN 57 | END; (* IF *) 58 | 59 | (* set up next iteration *) 60 | IF (index > minIndex) THEN 61 | (* calculate weight for next digit *) 62 | IF MAX(CARDINAL) DIV 10 > digitWeight THEN 63 | digitWeight := digitWeight * 10 64 | ELSE 65 | status := Overflow; 66 | RETURN 67 | END; (* IF *) 68 | 69 | (* calculate index for next digit *) 70 | digitIndex := digitIndex - 1 71 | ELSE 72 | status := Success; 73 | EXIT 74 | END (* IF *) 75 | END; (* LOOP *) 76 | 77 | value := accumulator 78 | END ToCard; 79 | 80 | 81 | PROCEDURE ToInt 82 | ( numStr : StringT; VAR value : INTEGER; VAR status : Status ); 83 | (* Converts the value represented by numStr to type INTEGER. *) 84 | 85 | VAR 86 | ch : CHAR; 87 | overflow, negative : BOOLEAN; 88 | index, minIndex, digitIndex : CARDINAL; 89 | accumulator, digitWeight, digitValue : INTEGER; 90 | 91 | BEGIN 92 | (* check sign *) 93 | ch := String.charAtIndex(numStr, 0); 94 | minIndex := 0; 95 | negative := FALSE; 96 | IF ch = '+' THEN 97 | minIndex := 1; 98 | ELSIF ch = '-' THEN 99 | minIndex := 1; 100 | negative := TRUE 101 | END; (* IF *) 102 | 103 | (* get the index for the right most character *) 104 | digitIndex := String.length(numStr); 105 | IF digitIndex > 0 THEN 106 | digitIndex := digitIndex - 1 107 | END; (* IF *) 108 | 109 | accumulator := 0; 110 | digitWeight := 1; 111 | 112 | (* iterate over all chars from right to left *) 113 | LOOP 114 | (* verify character is a digit *) 115 | ch := String.charAtIndex(numStr, digitIndex); 116 | IF (ch >= '0') AND (ch <= '9') THEN 117 | digitValue := digitWeight * VAL(INTEGER, ORD(ch) - ORD("0")) 118 | ELSE (* not a number *) 119 | status := NaN; 120 | RETURN 121 | END; (* IF *) 122 | 123 | (* add this digit's value to accumulator *) 124 | addInt(accumulator, digitValue, overflow); 125 | IF overflow THEN 126 | IF negative THEN 127 | status := Underflow 128 | ELSE 129 | status := Overflow 130 | END; 131 | RETURN 132 | END; (* IF *) 133 | 134 | (* set up next iteration *) 135 | IF (index > minIndex) THEN 136 | (* calculate weight for next digit *) 137 | IF MAX(INTEGER) DIV 10 > digitWeight THEN 138 | digitWeight := digitWeight * 10 139 | ELSE 140 | IF negative THEN 141 | status := Underflow 142 | ELSE 143 | status := Overflow 144 | END; 145 | RETURN 146 | END; (* IF *) 147 | 148 | (* calculate index for next digit *) 149 | digitIndex := digitIndex - 1 150 | ELSE 151 | status := Success; 152 | EXIT 153 | END (* IF *) 154 | END; (* LOOP *) 155 | 156 | value := accumulator 157 | END ToInt; 158 | 159 | 160 | (* ************************************************************************ * 161 | * Private Operations * 162 | * ************************************************************************ *) 163 | 164 | (* --------------------------------------------------------------------------- 165 | * function addCard(n, m, overflow) 166 | * --------------------------------------------------------------------------- 167 | * If n+m does not overflow, n+m is passed back in n and FALSE in overflow. 168 | * If n+m overflows, n is left unmodified and TRUE is passed back in overflow. 169 | * ------------------------------------------------------------------------ *) 170 | 171 | PROCEDURE addCard ( VAR n : CARDINAL; m : CARDINAL; VAR overflow : BOOLEAN ); 172 | 173 | BEGIN 174 | IF (m > 0) AND (n > MAX(CARDINAL) - m) THEN 175 | overflow := TRUE 176 | ELSE 177 | overflow := FALSE; 178 | n := n + m 179 | END 180 | END addCard; 181 | 182 | 183 | (* --------------------------------------------------------------------------- 184 | * function addInt(i, j, overflow) 185 | * --------------------------------------------------------------------------- 186 | * If i+j does not overflow, i+j is passed back in i and FALSE in overflow. 187 | * If i+j overflows, i is left unmodified and TRUE is passed back in overflow. 188 | * ------------------------------------------------------------------------ *) 189 | 190 | PROCEDURE addInt ( VAR i : INTEGER; j : INTEGER; VAR overflow : BOOLEAN ); 191 | 192 | BEGIN 193 | IF (i > 0) AND (i > MAX(INTEGER) - j) THEN 194 | overflow := TRUE 195 | ELSE 196 | overflow := FALSE; 197 | i := i + j 198 | END 199 | END addInt; 200 | 201 | 202 | END NumStr. -------------------------------------------------------------------------------- /src/imp/Settings.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE Settings; 4 | 5 | (* Program wide settings management *) 6 | 7 | IMPORT String, Newline, Tabulator; 8 | 9 | FROM String IMPORT StringT; (* alias for String.String *) 10 | 11 | 12 | TYPE Settings = SET OF Setting; 13 | 14 | 15 | CONST 16 | InfileDefault = String.Nil; 17 | OutfileDefault = String.Nil; 18 | TabWidthDefault = Tabulator.Default; 19 | NewlineModeDefault = Newline.Default; 20 | VerboseDefault = FALSE; 21 | ShowSettingsDefault = FALSE; 22 | 23 | 24 | VAR 25 | infileStr, 26 | outfileStr : StringT; 27 | verboseFlag, 28 | showSettingsFlag : BOOLEAN; 29 | modifiedSettings : Settings; 30 | 31 | 32 | PROCEDURE Reset ( setting : Setting ); 33 | (* Resets setting to its default. *) 34 | 35 | BEGIN 36 | CASE setting OF 37 | Infile : 38 | infileStr := InfileDefault 39 | | Outfile : 40 | outfileStr := OutfileDefault 41 | | TabWidth : 42 | Tabulator.SetTabWidth(TabWidthDefault) 43 | | NewlineMode : 44 | Newline.SetMode(NewlineModeDefault) 45 | | Verbose : 46 | verboseFlag := VerboseDefault 47 | | ShowSettings : 48 | showSettingsFlag := ShowSettingsDefault 49 | END; (* CASE *) 50 | 51 | EXCL(modifiedSettings, setting) 52 | END Reset; 53 | 54 | 55 | PROCEDURE alreadySet ( setting : Setting ) : BOOLEAN; 56 | (* Returns TRUE if setting has been modified since last reset, else FALSE. *) 57 | 58 | BEGIN 59 | RETURN setting IN modifiedSettings 60 | END alreadySet; 61 | 62 | 63 | PROCEDURE SetInfile ( path : StringT ); 64 | (* Sets the infile setting to path. *) 65 | 66 | BEGIN 67 | infileStr := path; 68 | INCL(modifiedSettings, Infile) 69 | END SetInfile; 70 | 71 | 72 | PROCEDURE infile () : StringT; 73 | (* Returns the infile setting. *) 74 | 75 | BEGIN 76 | RETURN infileStr 77 | END infile; 78 | 79 | 80 | PROCEDURE SetOutfile ( path : StringT ); 81 | (* Sets the outfile setting to path. *) 82 | 83 | BEGIN 84 | outfileStr := path; 85 | EXCL(modifiedSettings, Outfile) 86 | END SetOutfile; 87 | 88 | 89 | PROCEDURE outfile () : StringT; 90 | (* Returns the outfile setting. *) 91 | 92 | BEGIN 93 | RETURN outfileStr 94 | END outfile; 95 | 96 | 97 | PROCEDURE SetTabWidth ( value : Tabulator.TabWidth ); 98 | (* Sets the tabwidth setting to value. *) 99 | 100 | BEGIN 101 | Tabulator.SetTabWidth(value); 102 | INCL(modifiedSettings, TabWidth) 103 | END SetTabWidth; 104 | 105 | 106 | PROCEDURE tabWidth () : Tabulator.TabWidth; 107 | (* Returns the tabwidth setting. *) 108 | 109 | BEGIN 110 | RETURN Tabulator.tabWidth() 111 | END tabWidth; 112 | 113 | 114 | PROCEDURE SetNewlineMode ( mode : Newline.Mode ); 115 | (* Sets the newline mode setting to mode. *) 116 | 117 | BEGIN 118 | Newline.SetMode(mode); 119 | INCL(modifiedSettings, NewlineMode) 120 | END SetNewlineMode; 121 | 122 | 123 | PROCEDURE newlineMode () : Newline.Mode; 124 | (* Returns the newline mode setting. *) 125 | 126 | BEGIN 127 | RETURN Newline.mode() 128 | END newlineMode; 129 | 130 | 131 | PROCEDURE SetVerbose ( value : BOOLEAN ); 132 | (* Sets the verbose setting. *) 133 | 134 | BEGIN 135 | verboseFlag := value; 136 | INCL(modifiedSettings, Verbose) 137 | END SetVerbose; 138 | 139 | 140 | PROCEDURE verbose () : BOOLEAN; 141 | (* Returns the verbose setting. *) 142 | 143 | BEGIN 144 | RETURN verboseFlag 145 | END verbose; 146 | 147 | 148 | PROCEDURE SetShowSettings ( value : BOOLEAN ); 149 | (* Sets the show-settings setting. *) 150 | 151 | BEGIN 152 | showSettingsFlag := value; 153 | INCL(modifiedSettings, ShowSettings) 154 | END SetShowSettings; 155 | 156 | 157 | PROCEDURE showSettings () : BOOLEAN; 158 | (* Returns the show-settings setting. *) 159 | 160 | BEGIN 161 | RETURN showSettingsFlag 162 | END showSettings; 163 | 164 | 165 | PROCEDURE ResetAll; 166 | (* Resets all settings to their defaults. *) 167 | 168 | VAR 169 | setting : Setting; 170 | 171 | BEGIN 172 | FOR setting := MIN(Setting) TO MAX(Setting) DO 173 | Reset(setting) 174 | END (* FOR *) 175 | END ResetAll; 176 | 177 | 178 | BEGIN (* Settings *) 179 | modifiedSettings := Settings {}; 180 | infileStr := InfileDefault; 181 | outfileStr := OutfileDefault; 182 | verboseFlag := VerboseDefault; 183 | showSettingsFlag := ShowSettingsDefault 184 | END Settings. -------------------------------------------------------------------------------- /src/imp/StrBlank.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE StrBlank; 4 | 5 | (* String Blanks used internally by Module String *) 6 | 7 | 8 | (* --------------------------------------------------------------------------- 9 | * function allocSizeForStrLen(strlen) 10 | * --------------------------------------------------------------------------- 11 | * Returns the allocation size for a blank of length strlen as follows: 12 | * 13 | * case | strlen | offset | size | blank type 14 | * -----+--------------+--------+-----------+----------- 15 | * (0) | 0 .. 79 | +1 | strlen+1 | AOC0-AOC79 16 | * -----+--------------+--------+-----------+----------- 17 | * (1) | 80 .. 87 | +8 | 88 | AOC87 18 | * (2) | 88 .. 95 | +8 | 96 | AOC95 19 | * -----+--------------+--------+-----------+----------- 20 | * (3) | 96 .. 111 | +16 | 112 | AOC111 21 | * (4) | 112 .. 127 | +16 | 128 | AOC127 22 | * -----+--------------+--------+-----------+----------- 23 | * (5) | 128 .. 191 | +64 | 192 | AOC191 24 | * (6) | 192 .. 255 | +64 | 256 | AOC255 25 | * -----+--------------+--------+-----------+----------- 26 | * (7) | 256 .. 511 | +256 | 512 | AOC511 27 | * (8) | 512 .. 767 | +256 | 768 | AOC767 28 | * (9) | 768 .. 1023 | +256 | 1024 | AOC1023 29 | * (10) | 1024 .. 1279 | +256 | 1280 | AOC1279 30 | * (11) | 1280 .. 1535 | +256 | 1536 | AOC1535 31 | * (12) | 1536 .. 1791 | +256 | 1792 | AOC1791 32 | * (13) | 1792 .. 2047 | +256 | 2048 | AOC2047 33 | * -----+--------------+--------+-----------+----------- 34 | * (14) | 2048 .. 2559 | +512 | 2560 | AOC2559 35 | * (15) | 2560 .. 3071 | +512 | 3072 | AOC3071 36 | * -----+--------------+--------+-----------+----------- 37 | * (16) | >= 3072 | +1024 | MaxLength | Largest 38 | * ------------------------------------------------------------------------ *) 39 | 40 | PROCEDURE allocSizeForStrLen ( strlen : CARDINAL ) : CARDINAL; 41 | 42 | VAR 43 | size : CARDINAL; 44 | 45 | BEGIN 46 | IF strlen < 80 THEN 47 | (* case 0 *) size := strlen + 1 48 | ELSE 49 | IF strlen < 768 THEN 50 | IF strlen < 128 THEN 51 | IF strlen < 96 THEN 52 | IF strlen < 88 THEN 53 | (* case 1 *) size := 88 54 | ELSE (* strlen >= 88 *) 55 | (* case 2 *) size := 96 56 | END (* IF *) 57 | ELSE (* strlen >= 96 *) 58 | IF strlen < 112 THEN 59 | (* case 3 *) size := 112 60 | ELSE (* strlen >= 112 *) 61 | (* case 4 *) size := 128 62 | END (* IF *) 63 | END (* IF *) 64 | ELSE (* strlen >= 128 *) 65 | IF strlen < 256 THEN 66 | IF strlen < 192 THEN 67 | (* case 5 *) size := 192 68 | ELSE (* strlen >= 192 *) 69 | (* case 6 *) size := 256 70 | END (* IF *) 71 | ELSE (* strlen >= 256 *) 72 | IF strlen < 512 THEN 73 | (* case 7 *) size := 512 74 | ELSE (* strlen >= 512 *) 75 | (* case 8 *) size := 768 76 | END (* IF *) 77 | END (* IF *) 78 | END (* IF *) 79 | ELSE (* strlen >= 768 *) 80 | IF strlen < 1792 THEN 81 | IF strlen < 1280 THEN 82 | IF strlen < 1024 THEN 83 | (* case 9 *) size := 1024 84 | ELSE (* strlen >= 1024 *) 85 | (* case 10 *) size := 1280 86 | END (* IF *) 87 | ELSE (* strlen >= 1280 *) 88 | IF strlen < 1536 THEN 89 | (* case 11 *) size := 1536 90 | ELSE (* strlen >= 1536 *) 91 | (* case 12 *) size := 1792 92 | END (* IF *) 93 | END (* IF *) 94 | ELSE (* strlen >= 1792 *) 95 | IF strlen < 2560 THEN 96 | IF strlen < 2048 THEN 97 | (* case 13 *) size := 2048 98 | ELSE (* strlen >= 2048 *) 99 | (* case 14 *) size := 2560 100 | END (* IF *) 101 | ELSE (* strlen >= 2560 *) 102 | IF strlen < 3072 THEN 103 | (* case 15 *) size := 3072 104 | ELSE (* strlen >= 3072 *) 105 | (* case 16 *) size := MaxLength + 1 106 | END (* IF *) 107 | END (* IF *) 108 | END (* IF *) 109 | END (* IF *) 110 | END; (* IF *) 111 | 112 | RETURN size 113 | END allocSizeForStrLen; 114 | 115 | 116 | END StrBlank. -------------------------------------------------------------------------------- /src/imp/Tabulator.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE Tabulator; 4 | 5 | (* Tabulator management *) 6 | 7 | VAR defaultTabWidth : TabWidth; 8 | 9 | 10 | PROCEDURE SetTabWidth ( value : TabWidth ); 11 | (* Sets the tab width. Zero leaves tabs in place. *) 12 | 13 | BEGIN 14 | defaultTabWidth := value 15 | END SetTabWidth; 16 | 17 | 18 | PROCEDURE tabWidth ( ) : TabWidth; 19 | (* Returns the tab width. *) 20 | 21 | BEGIN 22 | RETURN defaultTabWidth; 23 | END tabWidth; 24 | 25 | 26 | BEGIN 27 | defaultTabWidth := Default 28 | END Tabulator. -------------------------------------------------------------------------------- /src/imp/Terminal.iso.mod: -------------------------------------------------------------------------------- 1 | (*!m2iso*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE Terminal; (* ISO version *) 4 | 5 | (* ISO emulation of PIM's Terminal library *) 6 | 7 | IMPORT STextIO; (* ISO library *) 8 | 9 | 10 | (* --------------------------------------------------------------------------- 11 | * procedure Read(ch) 12 | * --------------------------------------------------------------------------- 13 | * Blocking read operation. Reads a character from standard input. 14 | * ------------------------------------------------------------------------ *) 15 | 16 | PROCEDURE Read ( VAR ch : CHAR ); 17 | 18 | BEGIN 19 | STextIO.ReadChar(ch) 20 | END Read; 21 | 22 | 23 | (* --------------------------------------------------------------------------- 24 | * procedure Write(ch) 25 | * --------------------------------------------------------------------------- 26 | * Writes the given character to standard output. 27 | * ------------------------------------------------------------------------ *) 28 | 29 | PROCEDURE Write ( ch : CHAR ); 30 | 31 | BEGIN 32 | STextIO.WriteChar(ch) 33 | END Write; 34 | 35 | 36 | (* --------------------------------------------------------------------------- 37 | * procedure WriteString(array) 38 | * --------------------------------------------------------------------------- 39 | * Writes the given character array to standard output. 40 | * ------------------------------------------------------------------------ *) 41 | 42 | PROCEDURE WriteString ( array : ARRAY OF CHAR ); 43 | 44 | BEGIN 45 | STextIO.WriteString(array) 46 | END WriteString; 47 | 48 | 49 | (* --------------------------------------------------------------------------- 50 | * procedure WriteLn 51 | * --------------------------------------------------------------------------- 52 | * Writes newline to standard output. 53 | * ------------------------------------------------------------------------ *) 54 | 55 | PROCEDURE WriteLn; 56 | 57 | BEGIN 58 | STextIO.WriteLn 59 | END WriteLn; 60 | 61 | 62 | END Terminal. -------------------------------------------------------------------------------- /src/imp/Terminal.pim.txt: -------------------------------------------------------------------------------- 1 | Module Terminal is part of PIM. It should be included in any PIM Modula-2 compiler's library. 2 | -------------------------------------------------------------------------------- /src/imp/Terminal.posix.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE Terminal; (* POSIX version *) 4 | 5 | (* POSIX emulation of PIM's Terminal library *) 6 | 7 | IMPORT unistd; (* POSIX library *) 8 | 9 | IMPORT Newline; 10 | FROM SYSTEM IMPORT ADR; 11 | FROM ISO646 IMPORT NUL, LF, CR; 12 | 13 | 14 | (* --------------------------------------------------------------------------- 15 | * procedure Read(ch) 16 | * --------------------------------------------------------------------------- 17 | * Blocking read operation. Reads a character from standard input. 18 | * ------------------------------------------------------------------------ *) 19 | 20 | PROCEDURE Read ( VAR ch : CHAR ); 21 | 22 | VAR 23 | res : unistd.INT; 24 | 25 | BEGIN 26 | res := unistd.read(unistd.StdIn, ADR(ch), 1); 27 | END Read; 28 | 29 | 30 | (* --------------------------------------------------------------------------- 31 | * procedure Write(ch) 32 | * --------------------------------------------------------------------------- 33 | * Writes the given character to standard output. 34 | * ------------------------------------------------------------------------ *) 35 | 36 | PROCEDURE Write ( ch : CHAR ); 37 | 38 | VAR 39 | res : unistd.INT; 40 | 41 | BEGIN 42 | res := unistd.write(unistd.StdOut, ADR(ch), 1) 43 | END Write; 44 | 45 | 46 | (* --------------------------------------------------------------------------- 47 | * procedure WriteString(array) 48 | * --------------------------------------------------------------------------- 49 | * Writes the given character array to standard output. 50 | * ------------------------------------------------------------------------ *) 51 | 52 | PROCEDURE WriteString ( array : ARRAY OF CHAR ); 53 | 54 | VAR 55 | res : unistd.INT; 56 | len, maxIndex : CARDINAL; 57 | 58 | BEGIN 59 | maxIndex := HIGH(array); 60 | IF maxIndex = 0 THEN 61 | RETURN 62 | END; (* IF *) 63 | 64 | len := 0; 65 | WHILE (len < maxIndex) AND (array[len] # NUL) DO 66 | len := len + 1 67 | END; (* WHILE *) 68 | 69 | res := unistd.write(unistd.StdOut, ADR(array), len) 70 | END WriteString; 71 | 72 | 73 | (* --------------------------------------------------------------------------- 74 | * procedure WriteLn 75 | * --------------------------------------------------------------------------- 76 | * Writes newline to standard output. 77 | * ------------------------------------------------------------------------ *) 78 | 79 | PROCEDURE WriteLn; 80 | 81 | BEGIN 82 | CASE Newline.mode() OF 83 | Newline.LF : 84 | Write(LF) 85 | 86 | | Newline.CR : 87 | Write(CR) 88 | 89 | | Newline.CRLF : 90 | Write(CR); Write(LF) 91 | END (* CASE *) 92 | END WriteLn; 93 | 94 | 95 | END Terminal. -------------------------------------------------------------------------------- /src/imp/posix/stat.shim.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE stat; (* use for ACK and MOCKA *) 4 | 5 | (* User-level Modula-2 shim library to call POSIX stat *) 6 | 7 | IMPORT stat0; (* foreign interface *) 8 | 9 | FROM SYSTEM IMPORT ADR; 10 | 11 | 12 | (* chmod() *) 13 | 14 | PROCEDURE chmod ( path : ARRAY OF CHAR; mode : ModeT ) : INT; 15 | 16 | BEGIN 17 | RETURN stat0.chmod(ADR(path), mode) 18 | END chmod; 19 | 20 | 21 | (* mkdir() *) 22 | 23 | PROCEDURE mkdir ( path : ARRAY OF CHAR; mode : ModeT ) : INT; 24 | 25 | BEGIN 26 | RETURN stat0.mkdir(ADR(path), mode) 27 | END mkdir; 28 | 29 | 30 | (* stat() *) 31 | 32 | PROCEDURE stat ( path : ARRAY OF CHAR; VAR st : Stat ) : INT; 33 | 34 | BEGIN 35 | RETURN stat0.stat(ADR(path), ADR(st)) 36 | END stat; 37 | 38 | 39 | (* umask() *) 40 | 41 | PROCEDURE umask ( mode : ModeT ) : INT; 42 | 43 | BEGIN 44 | RETURN stat0.umask(mode) 45 | END umask; 46 | 47 | 48 | END stat. -------------------------------------------------------------------------------- /src/imp/posix/stdio.shim.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE stdio; (* use for ACK and MOCKA *) 4 | 5 | (* User-level Modula-2 shim library to call POSIX stdio *) 6 | 7 | IMPORT stdio0; (* foreign interface *) 8 | 9 | FROM SYSTEM IMPORT ADR, BYTE; 10 | 11 | 12 | (* fopen() *) 13 | 14 | PROCEDURE fopen ( filename, mode : ARRAY OF CHAR ) : FILE; 15 | 16 | BEGIN 17 | RETURN stdio0.fopen(ADR(filename), ADR(mode)) 18 | END fopen; 19 | 20 | 21 | (* fread() *) 22 | 23 | PROCEDURE fread 24 | ( VAR data : ARRAY OF BYTE; size, items : SizeT; stream : FILE ) : SizeT; 25 | 26 | BEGIN 27 | RETURN stdio0.fread(ADR(data), size, items, stream) 28 | END fread; 29 | 30 | 31 | (* fwrite() *) 32 | 33 | PROCEDURE fwrite 34 | ( data : ARRAY OF BYTE; size, items : SizeT; stream : FILE ) : SizeT; 35 | 36 | BEGIN 37 | RETURN stdio0.fwrite(ADR(data), size, items, stream) 38 | END fwrite; 39 | 40 | 41 | (* rename() *) 42 | 43 | PROCEDURE rename ( old, new : ARRAY OF CHAR ) : INT; 44 | 45 | BEGIN 46 | RETURN stdio0.rename(ADR(old), ADR(new)) 47 | END rename; 48 | 49 | 50 | (* remove() *) 51 | 52 | PROCEDURE remove ( path : ARRAY OF CHAR ) : INT; 53 | 54 | BEGIN 55 | RETURN stdio0.remove(ADR(path)) 56 | END remove; 57 | 58 | 59 | END stdio. -------------------------------------------------------------------------------- /src/imp/posix/unistd.shim.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE unistd; (* use for ACK and MOCKA *) 4 | 5 | (* User-level Modula-2 shim library to call POSIX unistd *) 6 | 7 | IMPORT unistd0; (* foreign interface *) 8 | 9 | FROM SYSTEM IMPORT ADR; 10 | 11 | 12 | (* access() *) 13 | 14 | PROCEDURE access ( path : ARRAY OF CHAR; mode : AccessMode ) : INT; 15 | 16 | BEGIN 17 | RETURN unistd0.access(ADR(path), VAL(INT, mode)) 18 | END access; 19 | 20 | 21 | (* unlink() *) 22 | 23 | PROCEDURE unlink ( path : ARRAY OF CHAR ) : INT; 24 | 25 | BEGIN 26 | RETURN unistd0.unlink(ADR(path)) 27 | END unlink; 28 | 29 | 30 | END unistd. -------------------------------------------------------------------------------- /src/posix/SysTypes.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE SysTypes; 4 | 5 | (* Modula-2 definition for POSIX sys/types *) 6 | 7 | 8 | (* type int *) 9 | 10 | TYPE INT = INTEGER; 11 | 12 | (* type uint *) 13 | 14 | TYPE UINT = CARDINAL; 15 | 16 | 17 | (* type size_t *) 18 | 19 | TYPE SizeT = CARDINAL; 20 | 21 | 22 | (* type ssize_t *) 23 | 24 | TYPE SSizeT = INTEGER; 25 | 26 | 27 | (* type pid_t *) 28 | 29 | TYPE PidT = INTEGER; 30 | 31 | 32 | (* type dev_t *) 33 | 34 | TYPE DevT = CARDINAL; 35 | 36 | 37 | (* type ino_t *) 38 | 39 | TYPE InoT = CARDINAL; 40 | 41 | 42 | (* type mode_t *) 43 | 44 | TYPE ModeT = INTEGER; 45 | 46 | 47 | (* type nlink_t *) 48 | 49 | TYPE NLinkT = INTEGER; 50 | 51 | 52 | (* type id_t *) 53 | 54 | TYPE IdT = INTEGER; 55 | 56 | 57 | (* type uid_t *) 58 | 59 | TYPE UidT = IdT; 60 | 61 | 62 | (* type gid_t *) 63 | 64 | TYPE GidT = IdT; 65 | 66 | 67 | (* type off_t *) 68 | 69 | TYPE OffT = INTEGER; 70 | 71 | 72 | (* type time_t *) 73 | 74 | TYPE TimeT = INTEGER; 75 | 76 | 77 | (* type blksize_t *) 78 | 79 | TYPE BlkSizeT = INTEGER; 80 | 81 | 82 | (* type blkcnt_t *) 83 | 84 | TYPE BlkCntT = INTEGER; 85 | 86 | 87 | END SysTypes. -------------------------------------------------------------------------------- /src/posix/stat.shim.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE stat; 4 | 5 | (* User-level Modula-2 shim library to call POSIX stat *) 6 | 7 | IMPORT stat0; (* foreign interface *) 8 | IMPORT SysTypes; (* POSIX sys/types *) 9 | 10 | 11 | (* type int *) 12 | 13 | TYPE INT = SysTypes.INT; 14 | 15 | 16 | (* type mode_t *) 17 | 18 | TYPE ModeT = SysTypes.ModeT; 19 | 20 | 21 | (* struct stat *) 22 | 23 | TYPE Stat = stat0.Stat; 24 | 25 | 26 | (* file mode flags *) 27 | 28 | CONST 29 | FileExists = 0; (* 0b0'0000'0000 *) 30 | OwnerReadable = 1; (* 0b0'0000'0001 *) 31 | OwnerWritable = 2, (* 0b0'0000'0010 *) 32 | OwnerExecutable = 4; (* 0b0'0000'0100 *) 33 | GroupReadable = 8; (* 0b0'0000'1000 *) 34 | GroupWritable = 16, (* 0b0'0001'0000 *) 35 | GroupExecutable = 32; (* 0b0'0010'0000 *) 36 | WorldReadable = 64; (* 0b0'0100'0000 *) 37 | WorldWritable = 128, (* 0b0'1000'0000 *) 38 | WorldExecutable = 256; (* 0b1'0000'0000 *) 39 | 40 | 41 | (* chmod() *) 42 | 43 | PROCEDURE chmod ( path : ARRAY OF CHAR; mode : ModeT ) : INT; 44 | 45 | 46 | (* mkdir() *) 47 | 48 | PROCEDURE mkdir ( path : ARRAY OF CHAR; mode : ModeT ) : INT; 49 | 50 | 51 | (* stat() *) 52 | 53 | PROCEDURE stat ( path : ARRAY OF CHAR; VAR st : Stat ) : INT; 54 | 55 | 56 | (* umask() *) 57 | 58 | PROCEDURE umask ( mode : ModeT ) : INT; 59 | 60 | 61 | END stat. -------------------------------------------------------------------------------- /src/posix/stat0.ack.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+ack*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | (*$Foreign language module *) 4 | 5 | DEFINITION MODULE stat0; (* ACK version *) 6 | 7 | (* Low-level Modula-2 interface to POSIX stat *) 8 | 9 | 10 | IMPORT SysTypes; (* POSIX sys/types *) 11 | 12 | FROM SYSTEM IMPORT ADDRESS (* void* *); 13 | 14 | 15 | (* type int *) 16 | 17 | TYPE INT = SysTypes.INT; 18 | 19 | 20 | (* type mode_t *) 21 | 22 | TYPE ModeT = SysTypes.ModeT; 23 | 24 | 25 | (* struct stat *) 26 | 27 | TYPE Stat = RECORD 28 | dev : SysTypes.DevT; 29 | ino : SysTypes.InoT; 30 | mode : SysTypes.ModeT; 31 | nlink : SysTypes.NLinkT; 32 | uid, 33 | gid : SysTypes.IdT; 34 | rdev : SysTypes.DevT; 35 | size : SysTypes.OffT; 36 | atime, 37 | mtime, 38 | ctime : SysTypes.TimeT 39 | END; (* Stat *) 40 | 41 | 42 | (* foreign declaration for int chmod(const char*, mode_t) *) 43 | 44 | PROCEDURE chmod ( path : ADDRESS; mode : ModeT ) : INT; 45 | 46 | 47 | (* foreign declaration for int mkdir(const char*, mode_t) *) 48 | 49 | PROCEDURE mkdir ( path : ADDRESS; mode : ModeT ) : INT; 50 | 51 | 52 | (* foreign declaration for int stat(const char*, struct stat* ) *) 53 | 54 | PROCEDURE stat ( path : ADDRESS; st : ADDRESS ) : INT; 55 | 56 | 57 | (* foreign declaration for int umask(mode_t) *) 58 | 59 | PROCEDURE umask ( mode : ModeT ) : INT; 60 | 61 | 62 | END stat0. -------------------------------------------------------------------------------- /src/posix/stat0.mocka.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | FOREIGN MODULE stat0; (* MOCKA version *) 4 | 5 | (* Low-level Modula-2 interface to POSIX stat *) 6 | 7 | 8 | IMPORT SysTypes; (* POSIX sys/types *) 9 | 10 | FROM SYSTEM IMPORT ADDRESS (* void* *); 11 | 12 | 13 | (* type int *) 14 | 15 | TYPE INT = SysTypes.INT; 16 | 17 | 18 | (* type mode_t *) 19 | 20 | TYPE ModeT = SysTypes.ModeT; 21 | 22 | 23 | (* struct stat *) 24 | 25 | TYPE Stat = RECORD 26 | dev : SysTypes.DevT; 27 | ino : SysTypes.InoT; 28 | mode : SysTypes.ModeT; 29 | nlink : SysTypes.NLinkT; 30 | uid, 31 | gid : SysTypes.IdT; 32 | rdev : SysTypes.DevT; 33 | size : SysTypes.OffT; 34 | atime, 35 | mtime, 36 | ctime : SysTypes.TimeT 37 | END; (* Stat *) 38 | 39 | 40 | (* foreign declaration for int chmod(const char*, mode_t) *) 41 | 42 | PROCEDURE chmod ( path : ADDRESS; mode : ModeT ) : INT; 43 | 44 | 45 | (* foreign declaration for int mkdir(const char*, mode_t) *) 46 | 47 | PROCEDURE mkdir ( path : ADDRESS; mode : ModeT ) : INT; 48 | 49 | 50 | (* foreign declaration for int stat(const char*, struct stat* ) *) 51 | 52 | PROCEDURE stat ( path : ADDRESS; st : ADDRESS ) : INT; 53 | 54 | 55 | (* foreign declaration for int umask(mode_t) *) 56 | 57 | PROCEDURE umask ( mode : ModeT ) : INT; 58 | 59 | 60 | END stat0. -------------------------------------------------------------------------------- /src/posix/stdio.gm2.iso.def: -------------------------------------------------------------------------------- 1 | (*!m2iso+gm2*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE FOR "C" stdio; (* GNU Modula-2 ISO version *) 4 | 5 | (* Modula-2 interface to POSIX stdio *) 6 | 7 | EXPORT UNQUALIFIED 8 | 9 | (* Errno constants *) 10 | EPERM, ENOENT, EIO, ENXIO, E2BIG, EBADF, ENOMEM, EACCES, EFAULT, ENOTBLK, 11 | EBUSY, EBUSY, EEXIST, EXDEV, ENODEV, ENOTDIR, EISDIR, EINVAL, ENFILE, 12 | EMFILE, ENOTTY, ETXTBSY, EFBIG, ENOSPC, ESPIPE, EROFS, EMLINK, EPIPE, 13 | EAGAIN, EWOULDBLOCK, ELOOP, ENAMETOOLONG, ENOTEMPTY, EFTYPE, EPWROFF, 14 | EDEVERR, ENODATA, ENODATA, ENOSR, ENOSTR, ETIME, 15 | 16 | (* types and functions *) 17 | FILE, SizeT, fopen, fflush, fclose, feof, fgetc, fputc, fread, fwrite, 18 | rename, remove, ferror, clearerr; 19 | 20 | 21 | FROM SYSTEM IMPORT 22 | LOC (* char *), 23 | ADDRESS (* void* *), 24 | INT32 (* int *), 25 | CSIZE_T (* size_t *); 26 | 27 | 28 | CONST 29 | EPERM (* Operation not permitted *) = 1; 30 | ENOENT (* No such file or directory *) = 2; 31 | EIO (* Input/output error *) = 5; 32 | ENXIO (* Device not configured *) = 6; 33 | E2BIG (* Argument list too long *) = 7; 34 | EBADF (* Bad file descriptor *) = 9; 35 | ENOMEM (* Cannot allocate memory *) = 12; 36 | EACCES (* Permission denied *) = 13; 37 | EFAULT (* Bad address *) = 14; 38 | ENOTBLK (* Block device required *) = 15; 39 | EBUSY (* Device or resource busy *) = 16; 40 | EEXIST (* File exists *) = 17; 41 | EXDEV (* Cross-device link *) = 18; 42 | ENODEV (* Operation not supported by device *) = 19; 43 | ENOTDIR (* Not a directory *) = 20; 44 | EISDIR (* Is a directory *) = 21; 45 | EINVAL (* Invalid argument *) = 22; 46 | ENFILE (* Too many open files in system *) = 23; 47 | EMFILE (* Too many open files *) = 24; 48 | ENOTTY (* Inappropriate ioctl for device *) = 25; 49 | ETXTBSY (* Text file busy *) = 26; 50 | EFBIG (* File too large *) = 27; 51 | ENOSPC (* No space left on device *) = 28; 52 | ESPIPE (* Illegal seek *) = 29; 53 | EROFS (* Read-only file system *) = 30; 54 | EMLINK (* Too many links *) = 31; 55 | EPIPE (* Broken pipe *) = 32; 56 | EAGAIN (* Resource temporarily unavailable *) = 35; 57 | EWOULDBLOCK (* Operation would block *) = EAGAIN; 58 | ELOOP (* Too many levels of symbolic links *) = 62; 59 | ENAMETOOLONG (* File name too long *) = 63; 60 | ENOTEMPTY (* Directory not empty *) = 66; 61 | EFTYPE (* Inappropriate file type or format *) = 79; 62 | EPWROFF (* Device power is off *) = 82; 63 | EDEVERR (* Device error *) = 83; 64 | ENODATA (* No message available on STREAM *) = 96; 65 | ENOSR (* No STREAM resources *) = 98; 66 | ENOSTR (* Not a STREAM *) = 99; 67 | ETIME (* STREAM ioctl timeout *) = 101; 68 | 69 | 70 | (* type FILE *) 71 | 72 | TYPE FILE = ADDRESS; 73 | 74 | 75 | (* type size_t *) 76 | 77 | TYPE SizeT = CSIZE_T; 78 | 79 | 80 | (* type int *) 81 | 82 | TYPE INT = INT32; 83 | 84 | 85 | (* foreign declaration for fopen() *) 86 | 87 | PROCEDURE fopen ( filename, mode : ARRAY OF CHAR ) : FILE; 88 | 89 | 90 | (* foreign declaration for fflush() *) 91 | 92 | PROCEDURE fflush ( stream : FILE ) : INT; 93 | 94 | 95 | (* foreign declaration for fclose() *) 96 | 97 | PROCEDURE fclose ( stream : FILE ) : INT; 98 | 99 | 100 | (* foreign declaration for feof() *) 101 | 102 | PROCEDURE feof ( stream : FILE ) : INT; 103 | 104 | 105 | (* foreign declaration for fgetc() *) 106 | 107 | PROCEDURE fgetc ( stream : FILE ) : INT; 108 | 109 | 110 | (* foreign declaration for fputc() *) 111 | 112 | PROCEDURE fputc ( c : INT; stream : FILE ) : INT; 113 | 114 | 115 | (* foreign declaration for fread() *) 116 | 117 | PROCEDURE fread 118 | ( VAR data : ARRAY OF LOC; size, items : SizeT; stream : FILE ) : SizeT; 119 | 120 | 121 | (* foreign declaration for fwrite() *) 122 | 123 | PROCEDURE fwrite 124 | ( data : ARRAY OF LOC; size, items : SizeT; stream : FILE ) : SizeT; 125 | 126 | 127 | (* foreign declaration for rename() *) 128 | 129 | PROCEDURE rename ( old, new : ARRAY OF CHAR ) : INT; 130 | 131 | 132 | (* foreign declaration for remove() *) 133 | 134 | PROCEDURE remove ( path : ARRAY OF CHAR ) : INT; 135 | 136 | 137 | (* foreign declaration for ferror() *) 138 | 139 | PROCEDURE ferror ( stream : FILE ) : INT; 140 | 141 | 142 | (* foreign declaration for clearerr() *) 143 | 144 | PROCEDURE clearerr ( stream : FILE ); 145 | 146 | 147 | END stdio. -------------------------------------------------------------------------------- /src/posix/stdio.gm2.pim.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+gm2*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE FOR "C" stdio; (* GNU Modula-2 PIM version *) 4 | 5 | (* Modula-2 interface to POSIX stdio *) 6 | 7 | EXPORT UNQUALIFIED 8 | 9 | (* Errno constants *) 10 | EPERM, ENOENT, EIO, ENXIO, E2BIG, EBADF, ENOMEM, EACCES, EFAULT, ENOTBLK, 11 | EBUSY, EBUSY, EEXIST, EXDEV, ENODEV, ENOTDIR, EISDIR, EINVAL, ENFILE, 12 | EMFILE, ENOTTY, ETXTBSY, EFBIG, ENOSPC, ESPIPE, EROFS, EMLINK, EPIPE, 13 | EAGAIN, EWOULDBLOCK, ELOOP, ENAMETOOLONG, ENOTEMPTY, EFTYPE, EPWROFF, 14 | EDEVERR, ENODATA, ENODATA, ENOSR, ENOSTR, ETIME, 15 | 16 | (* types and functions *) 17 | FILE, SizeT, fopen, fflush, fclose, feof, fgetc, fputc, fread, fwrite, 18 | rename, remove, ferror, clearerr; 19 | 20 | 21 | FROM SYSTEM IMPORT 22 | BYTE (* char *), 23 | ADDRESS (* void* *), 24 | INT32 (* int *), 25 | CSIZE_T (* size_t *); 26 | 27 | 28 | CONST 29 | EPERM (* Operation not permitted *) = 1; 30 | ENOENT (* No such file or directory *) = 2; 31 | EIO (* Input/output error *) = 5; 32 | ENXIO (* Device not configured *) = 6; 33 | E2BIG (* Argument list too long *) = 7; 34 | EBADF (* Bad file descriptor *) = 9; 35 | ENOMEM (* Cannot allocate memory *) = 12; 36 | EACCES (* Permission denied *) = 13; 37 | EFAULT (* Bad address *) = 14; 38 | ENOTBLK (* Block device required *) = 15; 39 | EBUSY (* Device or resource busy *) = 16; 40 | EEXIST (* File exists *) = 17; 41 | EXDEV (* Cross-device link *) = 18; 42 | ENODEV (* Operation not supported by device *) = 19; 43 | ENOTDIR (* Not a directory *) = 20; 44 | EISDIR (* Is a directory *) = 21; 45 | EINVAL (* Invalid argument *) = 22; 46 | ENFILE (* Too many open files in system *) = 23; 47 | EMFILE (* Too many open files *) = 24; 48 | ENOTTY (* Inappropriate ioctl for device *) = 25; 49 | ETXTBSY (* Text file busy *) = 26; 50 | EFBIG (* File too large *) = 27; 51 | ENOSPC (* No space left on device *) = 28; 52 | ESPIPE (* Illegal seek *) = 29; 53 | EROFS (* Read-only file system *) = 30; 54 | EMLINK (* Too many links *) = 31; 55 | EPIPE (* Broken pipe *) = 32; 56 | EAGAIN (* Resource temporarily unavailable *) = 35; 57 | EWOULDBLOCK (* Operation would block *) = EAGAIN; 58 | ELOOP (* Too many levels of symbolic links *) = 62; 59 | ENAMETOOLONG (* File name too long *) = 63; 60 | ENOTEMPTY (* Directory not empty *) = 66; 61 | EFTYPE (* Inappropriate file type or format *) = 79; 62 | EPWROFF (* Device power is off *) = 82; 63 | EDEVERR (* Device error *) = 83; 64 | ENODATA (* No message available on STREAM *) = 96; 65 | ENOSR (* No STREAM resources *) = 98; 66 | ENOSTR (* Not a STREAM *) = 99; 67 | ETIME (* STREAM ioctl timeout *) = 101; 68 | 69 | 70 | (* type FILE *) 71 | 72 | TYPE FILE = ADDRESS; 73 | 74 | 75 | (* type size_t *) 76 | 77 | TYPE SizeT = CSIZE_T; 78 | 79 | 80 | (* type int *) 81 | 82 | TYPE INT = INT32; 83 | 84 | 85 | (* foreign declaration for fopen() *) 86 | 87 | PROCEDURE fopen ( filename, mode : ARRAY OF CHAR ) : FILE; 88 | 89 | 90 | (* foreign declaration for fflush() *) 91 | 92 | PROCEDURE fflush ( stream : FILE ) : INT; 93 | 94 | 95 | (* foreign declaration for fclose() *) 96 | 97 | PROCEDURE fclose ( stream : FILE ) : INT; 98 | 99 | 100 | (* foreign declaration for feof() *) 101 | 102 | PROCEDURE feof ( stream : FILE ) : INT; 103 | 104 | 105 | (* foreign declaration for fgetc() *) 106 | 107 | PROCEDURE fgetc ( stream : FILE ) : INT; 108 | 109 | 110 | (* foreign declaration for fputc() *) 111 | 112 | PROCEDURE fputc ( c : INT; stream : FILE ) : INT; 113 | 114 | 115 | (* foreign declaration for fread() *) 116 | 117 | PROCEDURE fread 118 | ( VAR data : ARRAY OF BYTE; size, items : SizeT; stream : FILE ) : SizeT; 119 | 120 | 121 | (* foreign declaration for fwrite() *) 122 | 123 | PROCEDURE fwrite 124 | ( data : ARRAY OF BYTE; size, items : SizeT; stream : FILE ) : SizeT; 125 | 126 | 127 | (* foreign declaration for rename() *) 128 | 129 | PROCEDURE rename ( old, new : ARRAY OF CHAR ) : INT; 130 | 131 | 132 | (* foreign declaration for remove() *) 133 | 134 | PROCEDURE remove ( path : ARRAY OF CHAR ) : INT; 135 | 136 | 137 | (* foreign declaration for ferror() *) 138 | 139 | PROCEDURE ferror ( stream : FILE ) : INT; 140 | 141 | 142 | (* foreign declaration for clearerr() *) 143 | 144 | PROCEDURE clearerr ( stream : FILE ); 145 | 146 | 147 | END stdio. -------------------------------------------------------------------------------- /src/posix/stdio.p1.def: -------------------------------------------------------------------------------- 1 | (*!m2iso+p1*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | <*ASSIGN(Foreign,TRUE)*> <*ASSIGN(Calling,"CCalling")*> 4 | 5 | DEFINITION MODULE stdio; (* p1 version *) 6 | 7 | (* Modula-2 interface to POSIX stdio *) 8 | 9 | FROM SYSTEM IMPORT 10 | LOC (* char *), 11 | ADDRESS (* void* *), 12 | INT32 (* int *), 13 | CARD32 (* size_t in 32-bit mode *), 14 | CARD64 (* size_t in 64-bit mode *); 15 | 16 | 17 | CONST 18 | EPERM (* Operation not permitted *) = 1; 19 | ENOENT (* No such file or directory *) = 2; 20 | EIO (* Input/output error *) = 5; 21 | ENXIO (* Device not configured *) = 6; 22 | E2BIG (* Argument list too long *) = 7; 23 | EBADF (* Bad file descriptor *) = 9; 24 | ENOMEM (* Cannot allocate memory *) = 12; 25 | EACCES (* Permission denied *) = 13; 26 | EFAULT (* Bad address *) = 14; 27 | ENOTBLK (* Block device required *) = 15; 28 | EBUSY (* Device or resource busy *) = 16; 29 | EEXIST (* File exists *) = 17; 30 | EXDEV (* Cross-device link *) = 18; 31 | ENODEV (* Operation not supported by device *) = 19; 32 | ENOTDIR (* Not a directory *) = 20; 33 | EISDIR (* Is a directory *) = 21; 34 | EINVAL (* Invalid argument *) = 22; 35 | ENFILE (* Too many open files in system *) = 23; 36 | EMFILE (* Too many open files *) = 24; 37 | ENOTTY (* Inappropriate ioctl for device *) = 25; 38 | ETXTBSY (* Text file busy *) = 26; 39 | EFBIG (* File too large *) = 27; 40 | ENOSPC (* No space left on device *) = 28; 41 | ESPIPE (* Illegal seek *) = 29; 42 | EROFS (* Read-only file system *) = 30; 43 | EMLINK (* Too many links *) = 31; 44 | EPIPE (* Broken pipe *) = 32; 45 | EAGAIN (* Resource temporarily unavailable *) = 35; 46 | EWOULDBLOCK (* Operation would block *) = EAGAIN; 47 | ELOOP (* Too many levels of symbolic links *) = 62; 48 | ENAMETOOLONG (* File name too long *) = 63; 49 | ENOTEMPTY (* Directory not empty *) = 66; 50 | EFTYPE (* Inappropriate file type or format *) = 79; 51 | EPWROFF (* Device power is off *) = 82; 52 | EDEVERR (* Device error *) = 83; 53 | ENODATA (* No message available on STREAM *) = 96; 54 | ENOSR (* No STREAM resources *) = 98; 55 | ENOSTR (* Not a STREAM *) = 99; 56 | ETIME (* STREAM ioctl timeout *) = 101; 57 | 58 | 59 | (* type int *) 60 | 61 | TYPE INT = INT32; 62 | 63 | 64 | (* type FILE *) 65 | 66 | TYPE FILE = ADDRESS; 67 | 68 | 69 | (* type size_t *) 70 | 71 | (* PowerPC 32-bit *) 72 | <*IF(ARCH=ppc)THEN*> 73 | TYPE SizeT = CARD32; 74 | 75 | (* Intel x86 32-bit *) 76 | <*ELSIF(ARCH=i386)THEN*> 77 | TYPE SizeT = CARD32; 78 | 79 | (* Intel/AMD x86 64-bit *) 80 | <*ELSIF(ARCH=x86)THEN*> 81 | TYPE SizeT = CARD64; 82 | 83 | <*ELSE*> 84 | (* unsupported architecture *) 85 | <*END*> 86 | 87 | 88 | (* foreign declaration for fopen() *) 89 | 90 | PROCEDURE fopen ( filename, mode : ARRAY OF CHAR ) : FILE; 91 | 92 | 93 | (* foreign declaration for fflush() *) 94 | 95 | PROCEDURE fflush ( stream : FILE ) : INT; 96 | 97 | 98 | (* foreign declaration for fclose() *) 99 | 100 | PROCEDURE fclose ( stream : FILE ) : INT; 101 | 102 | 103 | (* foreign declaration for feof() *) 104 | 105 | PROCEDURE feof ( stream : FILE ) : INT; 106 | 107 | 108 | (* foreign declaration for fgetc() *) 109 | 110 | PROCEDURE fgetc ( stream : FILE ) : INT; 111 | 112 | 113 | (* foreign declaration for fputc() *) 114 | 115 | PROCEDURE fputc ( c : INT; stream : FILE ) : INT; 116 | 117 | 118 | (* foreign declaration for fread() *) 119 | 120 | PROCEDURE fread 121 | ( VAR data : ARRAY OF LOC; size, items : SizeT; stream : FILE ) : SizeT; 122 | 123 | 124 | (* foreign declaration for fwrite() *) 125 | 126 | PROCEDURE fwrite 127 | ( data : ARRAY OF LOC; size, items : SizeT; stream : FILE ) : SizeT; 128 | 129 | 130 | (* foreign declaration for rename() *) 131 | 132 | PROCEDURE rename ( old, new : ARRAY OF CHAR ) : INT; 133 | 134 | 135 | (* foreign declaration for remove() *) 136 | 137 | PROCEDURE remove ( path : ARRAY OF CHAR ) : INT; 138 | 139 | 140 | (* foreign declaration for ferror() *) 141 | 142 | PROCEDURE ferror ( stream : FILE ) : INT; 143 | 144 | 145 | (* foreign declaration for clearerr() *) 146 | 147 | PROCEDURE clearerr ( stream : FILE ); 148 | 149 | 150 | END stdio. -------------------------------------------------------------------------------- /src/posix/stdio.shim.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE stdio; (* use for ACK and MOCKA *) 4 | 5 | (* User-level Modula-2 shim library to call POSIX stdio *) 6 | 7 | IMPORT stdio0; 8 | FROM SYSTEM IMPORT BYTE; 9 | 10 | 11 | CONST 12 | EPERM (* Operation not permitted *) = 1; 13 | ENOENT (* No such file or directory *) = 2; 14 | EIO (* Input/output error *) = 5; 15 | ENXIO (* Device not configured *) = 6; 16 | E2BIG (* Argument list too long *) = 7; 17 | EBADF (* Bad file descriptor *) = 9; 18 | ENOMEM (* Cannot allocate memory *) = 12; 19 | EACCES (* Permission denied *) = 13; 20 | EFAULT (* Bad address *) = 14; 21 | ENOTBLK (* Block device required *) = 15; 22 | EBUSY (* Device or resource busy *) = 16; 23 | EEXIST (* File exists *) = 17; 24 | EXDEV (* Cross-device link *) = 18; 25 | ENODEV (* Operation not supported by device *) = 19; 26 | ENOTDIR (* Not a directory *) = 20; 27 | EISDIR (* Is a directory *) = 21; 28 | EINVAL (* Invalid argument *) = 22; 29 | ENFILE (* Too many open files in system *) = 23; 30 | EMFILE (* Too many open files *) = 24; 31 | ENOTTY (* Inappropriate ioctl for device *) = 25; 32 | ETXTBSY (* Text file busy *) = 26; 33 | EFBIG (* File too large *) = 27; 34 | ENOSPC (* No space left on device *) = 28; 35 | ESPIPE (* Illegal seek *) = 29; 36 | EROFS (* Read-only file system *) = 30; 37 | EMLINK (* Too many links *) = 31; 38 | EPIPE (* Broken pipe *) = 32; 39 | EAGAIN (* Resource temporarily unavailable *) = 11; 40 | EWOULDBLOCK (* Operation would block *) = EAGAIN; 41 | ELOOP (* Too many levels of symbolic links *) = 51; 42 | ENAMETOOLONG (* File name too long *) = 63; 43 | ENOTEMPTY (* Directory not empty *) = 66; 44 | EFTYPE (* Inappropriate file type or format *) = 79; 45 | EPWROFF (* Device power is off *) = 82; 46 | EDEVERR (* Device error *) = 83; 47 | ENODATA (* No message available on STREAM *) = 96; 48 | ENOSR (* No STREAM resources *) = 98; 49 | ENOSTR (* Not a STREAM *) = 99; 50 | ETIME (* STREAM ioctl timeout *) = 101; 51 | 52 | 53 | (* type FILE *) 54 | 55 | TYPE FILE = stdio0.FILE; 56 | 57 | 58 | (* type size_t *) 59 | 60 | TYPE SizeT = stdio0.SizeT; 61 | 62 | 63 | (* type int *) 64 | 65 | TYPE INT = stdio0.INT; 66 | 67 | 68 | (* fopen() *) 69 | 70 | PROCEDURE fopen ( filename, mode : ARRAY OF CHAR ) : FILE; 71 | 72 | 73 | (* fflush() *) 74 | 75 | CONST fflush = stdio0.fflush; 76 | 77 | 78 | (* fclose() *) 79 | 80 | CONST fclose = stdio0.fclose; 81 | 82 | 83 | (* feof() *) 84 | 85 | CONST feof = stdio0.feof; 86 | 87 | 88 | (* fgetc() *) 89 | 90 | CONST fgetc = stdio0.fgetc; 91 | 92 | 93 | (* fputc() *) 94 | 95 | CONST fputc = stdio0.fputc; 96 | 97 | 98 | (* fread() *) 99 | 100 | PROCEDURE fread 101 | ( VAR data : ARRAY OF BYTE; size, items : SizeT; stream : FILE ) : SizeT; 102 | 103 | 104 | (* fwrite() *) 105 | 106 | PROCEDURE fwrite 107 | ( data : ARRAY OF BYTE; size, items : SizeT; stream : FILE ) : SizeT; 108 | 109 | 110 | (* rename() *) 111 | 112 | PROCEDURE rename ( old, new : ARRAY OF CHAR ) : INT; 113 | 114 | 115 | (* remove() *) 116 | 117 | PROCEDURE remove ( path : ARRAY OF CHAR ) : INT; 118 | 119 | 120 | (* ferror() *) 121 | 122 | CONST ferror = stdio0.ferror; 123 | 124 | 125 | (* clearerr() *) 126 | 127 | CONST clearerr = stdio0.clearerr; 128 | 129 | 130 | END stdio. -------------------------------------------------------------------------------- /src/posix/stdio.xds.def: -------------------------------------------------------------------------------- 1 | (*!m2iso+xds*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | <*+M2EXTENSIONS*> <*+CSTDLIB*> 4 | 5 | DEFINITION MODULE ["C"] stdio; (* XDS Modula-2 version *) 6 | 7 | (* Modula-2 interface to POSIX stdio *) 8 | 9 | 10 | FROM SYSTEM IMPORT LOC, void, int, size_t; 11 | 12 | 13 | CONST 14 | EPERM (* Operation not permitted *) = 1; 15 | ENOENT (* No such file or directory *) = 2; 16 | EIO (* Input/output error *) = 5; 17 | ENXIO (* Device not configured *) = 6; 18 | E2BIG (* Argument list too long *) = 7; 19 | EBADF (* Bad file descriptor *) = 9; 20 | ENOMEM (* Cannot allocate memory *) = 12; 21 | EACCES (* Permission denied *) = 13; 22 | EFAULT (* Bad address *) = 14; 23 | ENOTBLK (* Block device required *) = 15; 24 | EBUSY (* Device or resource busy *) = 16; 25 | EEXIST (* File exists *) = 17; 26 | EXDEV (* Cross-device link *) = 18; 27 | ENODEV (* Operation not supported by device *) = 19; 28 | ENOTDIR (* Not a directory *) = 20; 29 | EISDIR (* Is a directory *) = 21; 30 | EINVAL (* Invalid argument *) = 22; 31 | ENFILE (* Too many open files in system *) = 23; 32 | EMFILE (* Too many open files *) = 24; 33 | ENOTTY (* Inappropriate ioctl for device *) = 25; 34 | ETXTBSY (* Text file busy *) = 26; 35 | EFBIG (* File too large *) = 27; 36 | ENOSPC (* No space left on device *) = 28; 37 | ESPIPE (* Illegal seek *) = 29; 38 | EROFS (* Read-only file system *) = 30; 39 | EMLINK (* Too many links *) = 31; 40 | EPIPE (* Broken pipe *) = 32; 41 | EAGAIN (* Resource temporarily unavailable *) = 35; 42 | EWOULDBLOCK (* Operation would block *) = EAGAIN; 43 | ELOOP (* Too many levels of symbolic links *) = 62; 44 | ENAMETOOLONG (* File name too long *) = 63; 45 | ENOTEMPTY (* Directory not empty *) = 66; 46 | EFTYPE (* Inappropriate file type or format *) = 79; 47 | EPWROFF (* Device power is off *) = 82; 48 | EDEVERR (* Device error *) = 83; 49 | ENODATA (* No message available on STREAM *) = 96; 50 | ENOSR (* No STREAM resources *) = 98; 51 | ENOSTR (* Not a STREAM *) = 99; 52 | ETIME (* STREAM ioctl timeout *) = 101; 53 | 54 | 55 | (* type FILE *) 56 | 57 | TYPE FILE = POINTER TO ["C"] void; 58 | 59 | 60 | (* type size_t *) 61 | 62 | TYPE SizeT = size_t; 63 | 64 | 65 | (* type int *) 66 | 67 | TYPE INT = int; 68 | 69 | 70 | (* foreign declaration for fopen() *) 71 | 72 | PROCEDURE fopen ( VAR (* CONST *) filename, mode : ARRAY OF CHAR ) : FILE; 73 | 74 | 75 | (* foreign declaration for fflush() *) 76 | 77 | PROCEDURE fflush ( stream : FILE ) : INT; 78 | 79 | 80 | (* foreign declaration for fclose() *) 81 | 82 | PROCEDURE fclose ( stream : FILE ) : INT; 83 | 84 | 85 | (* foreign declaration for feof() *) 86 | 87 | PROCEDURE feof ( stream : FILE ) : INT; 88 | 89 | 90 | (* foreign declaration for fgetc() *) 91 | 92 | PROCEDURE fgetc ( stream : FILE ) : INT; 93 | 94 | 95 | (* foreign declaration for fputc() *) 96 | 97 | PROCEDURE fputc ( c : int; stream : FILE ) : INT; 98 | 99 | 100 | (* foreign declaration for fread() *) 101 | 102 | PROCEDURE fread 103 | ( VAR data : ARRAY OF LOC; size, items : SizeT; stream : FILE ) : SizeT; 104 | 105 | 106 | (* foreign declaration for fwrite() *) 107 | 108 | PROCEDURE fwrite 109 | ( data : ARRAY OF LOC; size, items : SizeT; stream : FILE ) : SizeT; 110 | 111 | 112 | (* foreign declaration for rename() *) 113 | 114 | PROCEDURE rename ( VAR (* CONST *) old, new : ARRAY OF CHAR ) : INT; 115 | 116 | 117 | (* foreign declaration for remove() *) 118 | 119 | PROCEDURE remove ( VAR (* CONST *) path : ARRAY OF CHAR ) : INT; 120 | 121 | 122 | (* foreign declaration for ferror() *) 123 | 124 | PROCEDURE ferror ( stream : FILE ) : INT; 125 | 126 | 127 | (* foreign declaration for clearerr() *) 128 | 129 | PROCEDURE clearerr ( stream : FILE ); 130 | 131 | 132 | END stdio. 133 | -------------------------------------------------------------------------------- /src/posix/stdio0.ack.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+ack*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | (*$Foreign language module *) 4 | 5 | DEFINITION MODULE stdio0; (* ACK version *) 6 | 7 | (* Low-level Modula-2 interface to POSIX stdio *) 8 | 9 | FROM SYSTEM IMPORT ADDRESS; 10 | 11 | 12 | (* type int *) 13 | 14 | TYPE INT = INTEGER; 15 | 16 | 17 | (* type FILE *) 18 | 19 | TYPE FILE = ADDRESS; 20 | 21 | 22 | (* type size_t *) 23 | 24 | TYPE SizeT = CARDINAL; 25 | 26 | 27 | (* foreign declaration for fopen() *) 28 | 29 | PROCEDURE fopen ( filename, mode : ADDRESS ) : FILE; 30 | 31 | 32 | (* foreign declaration for fflush() *) 33 | 34 | PROCEDURE fflush ( stream : FILE ) : INT; 35 | 36 | 37 | (* foreign declaration for fclose() *) 38 | 39 | PROCEDURE fclose ( stream : FILE ) : INT; 40 | 41 | 42 | (* foreign declaration for feof() *) 43 | 44 | PROCEDURE feof ( stream : FILE ) : INT; 45 | 46 | 47 | (* foreign declaration for fgetc() *) 48 | 49 | PROCEDURE fgetc ( stream : FILE ) : INT; 50 | 51 | 52 | (* foreign declaration for fputc() *) 53 | 54 | PROCEDURE fputc ( c : INT; stream : FILE ) : INT; 55 | 56 | 57 | (* foreign declaration for fread() *) 58 | 59 | PROCEDURE fread 60 | ( data : ADDRESS; size, items : SizeT; stream : FILE ) : SizeT; 61 | 62 | 63 | (* foreign declaration for fwrite() *) 64 | 65 | PROCEDURE fwrite 66 | ( data : ADDRESS; size, items : SizeT; stream : FILE ) : SizeT; 67 | 68 | 69 | (* foreign declaration for rename() *) 70 | 71 | PROCEDURE rename ( old, new : ADDRESS ) : INT; 72 | 73 | 74 | (* foreign declaration for remove() *) 75 | 76 | PROCEDURE remove ( path : ADDRESS ) : INT; 77 | 78 | 79 | (* foreign declaration for ferror() *) 80 | 81 | PROCEDURE ferror ( stream : FILE ) : INT; 82 | 83 | 84 | (* foreign declaration for clearerr() *) 85 | 86 | PROCEDURE clearerr ( stream : FILE ); 87 | 88 | 89 | END stdio0. -------------------------------------------------------------------------------- /src/posix/stdio0.mocka.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | FOREIGN MODULE stdio0; (* MOCKA version *) 4 | 5 | (* Low-level Modula-2 interface to POSIX stdio *) 6 | 7 | 8 | FROM SYSTEM IMPORT ADDRESS (* void* *); 9 | 10 | 11 | (* type int *) 12 | 13 | TYPE INT = INTEGER; 14 | 15 | 16 | (* type FILE *) 17 | 18 | TYPE FILE = ADDRESS; 19 | 20 | 21 | (* type size_t *) 22 | 23 | TYPE SizeT = CARDINAL; 24 | 25 | 26 | (* foreign declaration for fopen() *) 27 | 28 | PROCEDURE fopen ( filename, mode : ADDRESS ) : FILE; 29 | 30 | 31 | (* foreign declaration for fflush() *) 32 | 33 | PROCEDURE fflush ( stream : FILE ) : INT; 34 | 35 | 36 | (* foreign declaration for fclose() *) 37 | 38 | PROCEDURE fclose ( stream : FILE ) : INT; 39 | 40 | 41 | (* foreign declaration for feof() *) 42 | 43 | PROCEDURE feof ( stream : FILE ) : INT; 44 | 45 | 46 | (* foreign declaration for fgetc() *) 47 | 48 | PROCEDURE fgetc ( stream : FILE ) : INT; 49 | 50 | 51 | (* foreign declaration for fputc() *) 52 | 53 | PROCEDURE fputc ( c : INT; stream : FILE ) : INT; 54 | 55 | 56 | (* foreign declaration for fread() *) 57 | 58 | PROCEDURE fread 59 | ( data : ADDRESS; size, items : SizeT; stream : FILE ) : SizeT; 60 | 61 | 62 | (* foreign declaration for fwrite() *) 63 | 64 | PROCEDURE fwrite 65 | ( data : ADDRESS; size, items : SizeT; stream : FILE ) : SizeT; 66 | 67 | 68 | (* foreign declaration for rename() *) 69 | 70 | PROCEDURE rename ( old, new : ADDRESS ) : INT; 71 | 72 | 73 | (* foreign declaration for remove() *) 74 | 75 | PROCEDURE remove ( path : ADDRESS ) : INT; 76 | 77 | 78 | (* foreign declaration for ferror() *) 79 | 80 | PROCEDURE ferror ( stream : FILE ) : INT; 81 | 82 | 83 | (* foreign declaration for clearerr() *) 84 | 85 | PROCEDURE clearerr ( stream : FILE ); 86 | 87 | 88 | END stdio0. -------------------------------------------------------------------------------- /src/posix/templates/stdio.gm2.gen.def: -------------------------------------------------------------------------------- 1 | (*!m2##ver##+gm2*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE FOR "C" stdio; (* GNU Modula-2 ##VER## version *) 4 | 5 | (* Modula-2 interface to POSIX stdio *) 6 | 7 | EXPORT UNQUALIFIED 8 | 9 | (* Errno constants *) 10 | EPERM, ENOENT, EIO, ENXIO, E2BIG, EBADF, ENOMEM, EACCES, EFAULT, ENOTBLK, 11 | EBUSY, EBUSY, EEXIST, EXDEV, ENODEV, ENOTDIR, EISDIR, EINVAL, ENFILE, 12 | EMFILE, ENOTTY, ETXTBSY, EFBIG, ENOSPC, ESPIPE, EROFS, EMLINK, EPIPE, 13 | EAGAIN, EWOULDBLOCK, ELOOP, ENAMETOOLONG, ENOTEMPTY, EFTYPE, EPWROFF, 14 | EDEVERR, ENODATA, ENODATA, ENOSR, ENOSTR, ETIME, 15 | 16 | (* types and functions *) 17 | FILE, SizeT, fopen, fflush, fclose, feof, fgetc, fputc, fread, fwrite, 18 | rename, remove, ferror, clearerr; 19 | 20 | 21 | FROM SYSTEM IMPORT 22 | ##locOrByte## (* char *), 23 | ADDRESS (* void* *), 24 | INT32 (* int *), 25 | CSIZE_T (* size_t *); 26 | 27 | 28 | CONST 29 | EPERM (* Operation not permitted *) = 1; 30 | ENOENT (* No such file or directory *) = 2; 31 | EIO (* Input/output error *) = 5; 32 | ENXIO (* Device not configured *) = 6; 33 | E2BIG (* Argument list too long *) = 7; 34 | EBADF (* Bad file descriptor *) = 9; 35 | ENOMEM (* Cannot allocate memory *) = 12; 36 | EACCES (* Permission denied *) = 13; 37 | EFAULT (* Bad address *) = 14; 38 | ENOTBLK (* Block device required *) = 15; 39 | EBUSY (* Device or resource busy *) = 16; 40 | EEXIST (* File exists *) = 17; 41 | EXDEV (* Cross-device link *) = 18; 42 | ENODEV (* Operation not supported by device *) = 19; 43 | ENOTDIR (* Not a directory *) = 20; 44 | EISDIR (* Is a directory *) = 21; 45 | EINVAL (* Invalid argument *) = 22; 46 | ENFILE (* Too many open files in system *) = 23; 47 | EMFILE (* Too many open files *) = 24; 48 | ENOTTY (* Inappropriate ioctl for device *) = 25; 49 | ETXTBSY (* Text file busy *) = 26; 50 | EFBIG (* File too large *) = 27; 51 | ENOSPC (* No space left on device *) = 28; 52 | ESPIPE (* Illegal seek *) = 29; 53 | EROFS (* Read-only file system *) = 30; 54 | EMLINK (* Too many links *) = 31; 55 | EPIPE (* Broken pipe *) = 32; 56 | EAGAIN (* Resource temporarily unavailable *) = 35; 57 | EWOULDBLOCK (* Operation would block *) = EAGAIN; 58 | ELOOP (* Too many levels of symbolic links *) = 62; 59 | ENAMETOOLONG (* File name too long *) = 63; 60 | ENOTEMPTY (* Directory not empty *) = 66; 61 | EFTYPE (* Inappropriate file type or format *) = 79; 62 | EPWROFF (* Device power is off *) = 82; 63 | EDEVERR (* Device error *) = 83; 64 | ENODATA (* No message available on STREAM *) = 96; 65 | ENOSR (* No STREAM resources *) = 98; 66 | ENOSTR (* Not a STREAM *) = 99; 67 | ETIME (* STREAM ioctl timeout *) = 101; 68 | 69 | 70 | (* type FILE *) 71 | 72 | TYPE FILE = ADDRESS; 73 | 74 | 75 | (* type size_t *) 76 | 77 | TYPE SizeT = CSIZE_T; 78 | 79 | 80 | (* type int *) 81 | 82 | TYPE INT = INT32; 83 | 84 | 85 | (* foreign declaration for fopen() *) 86 | 87 | PROCEDURE fopen ( filename, mode : ARRAY OF CHAR ) : FILE; 88 | 89 | 90 | (* foreign declaration for fflush() *) 91 | 92 | PROCEDURE fflush ( stream : FILE ) : INT; 93 | 94 | 95 | (* foreign declaration for fclose() *) 96 | 97 | PROCEDURE fclose ( stream : FILE ) : INT; 98 | 99 | 100 | (* foreign declaration for feof() *) 101 | 102 | PROCEDURE feof ( stream : FILE ) : INT; 103 | 104 | 105 | (* foreign declaration for fgetc() *) 106 | 107 | PROCEDURE fgetc ( stream : FILE ) : INT; 108 | 109 | 110 | (* foreign declaration for fputc() *) 111 | 112 | PROCEDURE fputc ( c : INT; stream : FILE ) : INT; 113 | 114 | 115 | (* foreign declaration for fread() *) 116 | 117 | PROCEDURE fread 118 | ( VAR data : ARRAY OF LOC; size, items : SizeT; stream : FILE ) : SizeT; 119 | 120 | 121 | (* foreign declaration for fwrite() *) 122 | 123 | PROCEDURE fwrite 124 | ( data : ARRAY OF LOC; size, items : SizeT; stream : FILE ) : SizeT; 125 | 126 | 127 | (* foreign declaration for rename() *) 128 | 129 | PROCEDURE rename ( old, new : ARRAY OF CHAR ) : INT; 130 | 131 | 132 | (* foreign declaration for remove() *) 133 | 134 | PROCEDURE remove ( path : ARRAY OF CHAR ) : INT; 135 | 136 | 137 | (* foreign declaration for ferror() *) 138 | 139 | PROCEDURE ferror ( stream : FILE ) : INT; 140 | 141 | 142 | (* foreign declaration for clearerr() *) 143 | 144 | PROCEDURE clearerr ( stream : FILE ); 145 | 146 | 147 | END stdio. -------------------------------------------------------------------------------- /src/posix/templates/stdio0.gen.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+##ver##*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | ##ffiPragmas## 4 | ##foreignDefModPrefix## MODULE stdio0; (* ##VER## version *) 5 | 6 | (* Low-level Modula-2 interface to POSIX stdio *) 7 | 8 | FROM SYSTEM IMPORT ADDRESS; 9 | 10 | 11 | (* type int *) 12 | 13 | TYPE INT = ##intType##; 14 | 15 | 16 | (* type FILE *) 17 | 18 | TYPE FILE = ADDRESS; 19 | 20 | 21 | (* type size_t *) 22 | 23 | TYPE SizeT = ##sizetType##; 24 | 25 | 26 | (* foreign declaration for fopen() *) 27 | 28 | PROCEDURE fopen ( filename, mode : ADDRESS ) : FILE; 29 | 30 | 31 | (* foreign declaration for fflush() *) 32 | 33 | PROCEDURE fflush ( stream : FILE ) : INT; 34 | 35 | 36 | (* foreign declaration for fclose() *) 37 | 38 | PROCEDURE fclose ( stream : FILE ) : INT; 39 | 40 | 41 | (* foreign declaration for feof() *) 42 | 43 | PROCEDURE feof ( stream : FILE ) : INT; 44 | 45 | 46 | (* foreign declaration for fgetc() *) 47 | 48 | PROCEDURE fgetc ( stream : FILE ) : INT; 49 | 50 | 51 | (* foreign declaration for fputc() *) 52 | 53 | PROCEDURE fputc ( c : INT; stream : FILE ) : INT; 54 | 55 | 56 | (* foreign declaration for fread() *) 57 | 58 | PROCEDURE fread 59 | ( data : ADDRESS; size, items : SizeT; stream : FILE ) : SizeT; 60 | 61 | 62 | (* foreign declaration for fwrite() *) 63 | 64 | PROCEDURE fwrite 65 | ( data : ADDRESS; size, items : SizeT; stream : FILE ) : SizeT; 66 | 67 | 68 | (* foreign declaration for rename() *) 69 | 70 | PROCEDURE rename ( old, new : ADDRESS ) : INT; 71 | 72 | 73 | (* foreign declaration for remove() *) 74 | 75 | PROCEDURE remove ( path : ADDRESS ) : INT; 76 | 77 | 78 | (* foreign declaration for ferror() *) 79 | 80 | PROCEDURE ferror ( stream : FILE ) : INT; 81 | 82 | 83 | (* foreign declaration for clearerr() *) 84 | 85 | PROCEDURE clearerr ( stream : FILE ); 86 | 87 | 88 | END stdio0. -------------------------------------------------------------------------------- /src/posix/templates/unistd0.gen.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+##ver##*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | ##ffiPragmas## 4 | ##foreignDefModPrefix## MODULE unistd0; (* ##VER## version *) 5 | 6 | (* Low-level Modula-2 interface to POSIX unistd *) 7 | 8 | 9 | FROM SYSTEM IMPORT ADDRESS (* void* *); 10 | 11 | 12 | (* type int *) 13 | 14 | TYPE INT = ##intType##; 15 | 16 | 17 | (* type size_t *) 18 | 19 | TYPE SizeT = ##sizetType##; 20 | 21 | 22 | (* type ssize_t *) 23 | 24 | TYPE SSizeT = ##ssizetType##; 25 | 26 | 27 | (* foreign declaration for access() *) 28 | 29 | PROCEDURE access ( path : ADDRESS; mode : INT ) : INT; 30 | 31 | 32 | (* foreign declaration for read() *) 33 | 34 | PROCEDURE read ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 35 | 36 | 37 | (* foreign declaration for write() *) 38 | 39 | PROCEDURE write ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 40 | 41 | 42 | (* foreign declaration for unlink() *) 43 | 44 | PROCEDURE unlink ( path : ADDRESS ) : INT; 45 | 46 | 47 | END unistd0. -------------------------------------------------------------------------------- /src/posix/unistd.gm2.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+gm2*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE FOR "C" unistd; (* GNU Modula-2 version *) 4 | 5 | (* Modula-2 interface to POSIX unistd *) 6 | 7 | FROM SYSTEM IMPORT 8 | ADDRESS, INT32 (* int *), CSIZE_T (* size_t *), CSSIZE_T (* ssize_t *); 9 | 10 | 11 | (* type int *) 12 | 13 | TYPE INT = INT32; 14 | 15 | 16 | (* type size_t *) 17 | 18 | TYPE SizeT = CSIZE_T; 19 | 20 | 21 | (* type ssize_t *) 22 | 23 | TYPE SSizeT = CSSIZE_T; 24 | 25 | 26 | TYPE AccessMode = INT [0..7]; 27 | 28 | 29 | CONST 30 | FileExists = 0; (* 0b0000 *) 31 | Executable = 1; (* 0b0001 *) 32 | Writable = 2, (* 0b0010 *) 33 | Readable = 4; (* 0b0100 *) 34 | 35 | 36 | CONST 37 | StdIn = 0; (* STDIN_FILENO *) 38 | StdOut = 1; (* STDOUT_FILENO *) 39 | StdErr = 2; (* STDERR_FILENO *) 40 | 41 | 42 | (* foreign declaration for access() *) 43 | 44 | PROCEDURE access ( path : ARRAY OF CHAR; mode : AccessMode ) : INT; 45 | 46 | 47 | (* foreign declaration for read() *) 48 | 49 | PROCEDURE read ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 50 | 51 | 52 | (* foreign declaration for write() *) 53 | 54 | PROCEDURE write ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 55 | 56 | 57 | (* foreign declaration for unlink() *) 58 | 59 | PROCEDURE unlink ( path : ARRAY OF CHAR ) : INT; 60 | 61 | 62 | END unistd. -------------------------------------------------------------------------------- /src/posix/unistd.p1.def: -------------------------------------------------------------------------------- 1 | (*!m2iso+p1*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | <*ASSIGN(Foreign,TRUE)*> <*ASSIGN(Calling,"CCalling")*> 4 | 5 | DEFINITION MODULE unistd; (* p1 version *) 6 | 7 | (* Modula-2 interface to POSIX unistd *) 8 | 9 | FROM SYSTEM IMPORT ADDRESS, CARD32, INT32; 10 | <*IF(ARCH=x86)THEN*> 11 | FROM SYSTEM IMPORT CARD64, INT64; 12 | <*END*> 13 | 14 | 15 | (* type int *) 16 | 17 | TYPE INT = INT32; 18 | 19 | 20 | (* types size_t and ssize_t *) 21 | 22 | (* PowerPC 32-bit *) 23 | <*IF(ARCH=ppc)THEN*> 24 | TYPE SizeT = CARD32; 25 | TYPE SSizeT = INT32; 26 | 27 | (* Intel x86 32-bit *) 28 | <*ELSIF(ARCH=i386)THEN*> 29 | TYPE SizeT = CARD32; 30 | TYPE SSizeT = INT32; 31 | 32 | (* Intel/AMD x86 64-bit *) 33 | <*ELSIF(ARCH=x86)THEN*> 34 | TYPE SizeT = CARD64; 35 | TYPE SSizeT = INT64; 36 | 37 | <*ELSE*> 38 | (* unsupported architecture *) 39 | <*END*> 40 | 41 | 42 | TYPE AccessMode = INT [0..7]; 43 | 44 | 45 | CONST 46 | FileExists = 0; (* 0b0000 *) 47 | Executable = 1; (* 0b0001 *) 48 | Writable = 2; (* 0b0010 *) 49 | Readable = 4; (* 0b0100 *) 50 | 51 | 52 | CONST 53 | StdIn = 0; (* STDIN_FILENO *) 54 | StdOut = 1; (* STDOUT_FILENO *) 55 | StdErr = 2; (* STDERR_FILENO *) 56 | 57 | 58 | (* foreign declaration for access() *) 59 | 60 | PROCEDURE access ( path : ARRAY OF CHAR; mode : AccessMode ) : INT; 61 | 62 | 63 | (* foreign declaration for read() *) 64 | 65 | PROCEDURE read ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 66 | 67 | 68 | (* foreign declaration for write() *) 69 | 70 | PROCEDURE write ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 71 | 72 | 73 | (* foreign declaration for unlink() *) 74 | 75 | PROCEDURE unlink ( path : ARRAY OF CHAR ) : INT; 76 | 77 | 78 | END unistd. -------------------------------------------------------------------------------- /src/posix/unistd.shim.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE unistd; (* use for ACK and MOCKA *) 4 | 5 | (* User-level Modula-2 shim library to call POSIX unistd *) 6 | 7 | IMPORT unistd0; (* foreign interface *) 8 | 9 | 10 | (* type int *) 11 | 12 | TYPE INT = unistd0.INT; 13 | 14 | 15 | (* type size_t *) 16 | 17 | TYPE SizeT = unistd0.SizeT; 18 | 19 | 20 | (* type ssize_t *) 21 | 22 | TYPE SSizeT = unistd0.SSizeT; 23 | 24 | 25 | TYPE AccessMode = INT [0..7]; 26 | 27 | 28 | CONST 29 | FileExists = 0; (* 0b0000 *) 30 | Executable = 1; (* 0b0001 *) 31 | Writable = 2, (* 0b0010 *) 32 | Readable = 4; (* 0b0100 *) 33 | 34 | 35 | CONST 36 | StdIn = 0; (* STDIN_FILENO *) 37 | StdOut = 1; (* STDOUT_FILENO *) 38 | StdErr = 2; (* STDERR_FILENO *) 39 | 40 | 41 | (* access() *) 42 | 43 | PROCEDURE access ( path : ARRAY OF CHAR; mode : AccessMode ) : INT; 44 | 45 | 46 | (* read() *) 47 | 48 | CONST read = stdio0.read; 49 | 50 | 51 | (* write() *) 52 | 53 | CONST write = stdio0.write; 54 | 55 | 56 | (* unlink() *) 57 | 58 | PROCEDURE unlink ( path : ARRAY OF CHAR ) : INT; 59 | 60 | 61 | END unistd. -------------------------------------------------------------------------------- /src/posix/unistd.xds.def: -------------------------------------------------------------------------------- 1 | (*!m2iso+xds*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | <*+M2EXTENSIONS*> <*+CSTDLIB*> 4 | 5 | DEFINITION MODULE ["C"] unistd; (* XDS Modula-2 version *) 6 | 7 | (* Modula-2 interface to POSIX unistd *) 8 | 9 | FROM SYSTEM IMPORT ADDRESS, int, size_t; 10 | 11 | 12 | (* type int *) 13 | 14 | TYPE INT = int; 15 | 16 | 17 | (* type size_t *) 18 | 19 | TYPE SizeT = size_t; 20 | 21 | 22 | (* type ssize_t *) 23 | 24 | <*IF(TSIZE(SizeT)=TSIZE(INTEGER))THEN*> 25 | TYPE SSizeT = INTEGER; 26 | <*ELSIF(TSIZE(SizeT)=TSIZE(LONGINT))THEN)*> 27 | TYPE SSizeT = LONGINT; 28 | <*END*> 29 | 30 | 31 | TYPE AccessMode = INT [0..7]; 32 | 33 | 34 | CONST 35 | FileExists = 0; (* 0b0000 *) 36 | Executable = 1; (* 0b0001 *) 37 | Writable = 2, (* 0b0010 *) 38 | Readable = 4; (* 0b0100 *) 39 | 40 | 41 | CONST 42 | StdIn = 0; (* STDIN_FILENO *) 43 | StdOut = 1; (* STDOUT_FILENO *) 44 | StdErr = 2; (* STDERR_FILENO *) 45 | 46 | 47 | (* foreign declaration for access() *) 48 | 49 | PROCEDURE access ( path : ARRAY OF CHAR; mode : AccessMode ) : INT; 50 | 51 | 52 | (* foreign declaration for read() *) 53 | 54 | PROCEDURE read ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 55 | 56 | 57 | (* foreign declaration for write() *) 58 | 59 | PROCEDURE write ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 60 | 61 | 62 | (* foreign declaration for unlink() *) 63 | 64 | PROCEDURE unlink ( path : ARRAY OF CHAR ) : INT; 65 | 66 | 67 | END unistd. -------------------------------------------------------------------------------- /src/posix/unistd0.ack.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+ack*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | (*$Foreign language module *) 4 | 5 | DEFINITION MODULE unistd0; (* ACK version *) 6 | 7 | (* Low-level Modula-2 interface to POSIX unistd *) 8 | 9 | 10 | FROM SYSTEM IMPORT ADDRESS (* void* *); 11 | 12 | 13 | (* type int *) 14 | 15 | TYPE INT = INTEGER; 16 | 17 | 18 | (* type size_t *) 19 | 20 | TYPE SizeT = CARDINAL; 21 | 22 | 23 | (* type ssize_t *) 24 | 25 | TYPE SSizeT = INTEGER; 26 | 27 | 28 | (* foreign declaration for access() *) 29 | 30 | PROCEDURE access ( path : ADDRESS; mode : INT ) : INT; 31 | 32 | 33 | (* foreign declaration for read() *) 34 | 35 | PROCEDURE read ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 36 | 37 | 38 | (* foreign declaration for write() *) 39 | 40 | PROCEDURE write ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 41 | 42 | 43 | (* foreign declaration for unlink() *) 44 | 45 | PROCEDURE unlink ( path : ADDRESS ) : INT; 46 | 47 | 48 | END unistd0. -------------------------------------------------------------------------------- /src/posix/unistd0.mocka.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | FOREIGN MODULE unistd0; (* MOCKA version *) 4 | 5 | (* Low-level Modula-2 interface to POSIX unistd *) 6 | 7 | 8 | FROM SYSTEM IMPORT ADDRESS (* void* *); 9 | 10 | 11 | (* type int *) 12 | 13 | TYPE INT = INTEGER; 14 | 15 | 16 | (* type size_t *) 17 | 18 | TYPE SizeT = CARDINAL; 19 | 20 | 21 | (* type ssize_t *) 22 | 23 | TYPE SSizeT = INTEGER; 24 | 25 | 26 | (* foreign declaration for access() *) 27 | 28 | PROCEDURE access ( path : ADDRESS; mode : INT ) : INT; 29 | 30 | 31 | (* foreign declaration for read() *) 32 | 33 | PROCEDURE read ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 34 | 35 | 36 | (* foreign declaration for write() *) 37 | 38 | PROCEDURE write ( fildes : INT; buf : ADDRESS; nbyte : SizeT ) : SSizeT; 39 | 40 | 41 | (* foreign declaration for unlink() *) 42 | 43 | PROCEDURE unlink ( path : ADDRESS ) : INT; 44 | 45 | 46 | END unistd0. -------------------------------------------------------------------------------- /src/templates/BuildInfo.gen.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) DEFINITION MODULE BuildInfo; (* auto-generated file *) 2 | 3 | CONST 4 | Platform = ##platform##; 5 | Dialect = ##dialect##; 6 | Compiler = ##compiler##; 7 | IOLibrary = ##iolib##; 8 | MemModel = ##mm##; 9 | 10 | END BuildInfo. -------------------------------------------------------------------------------- /src/templates/Hash.gen.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Hash; (* ##VER## version *) 4 | 5 | (* General Purpose ##bitwidth##-bit Hash Function *) 6 | 7 | TYPE Key = ##KeyType##; (* must be at least ##bitwidth## bits wide *) 8 | 9 | (* Library will abort the client program if ##KeyType## is less than ##bitwidth##-bit. *) 10 | 11 | 12 | (* --------------------------------------------------------------------------- 13 | * function Hash.initialValue() 14 | * --------------------------------------------------------------------------- 15 | * Returns the initial hash value for incremental hash calculation. 16 | * ------------------------------------------------------------------------ *) 17 | 18 | PROCEDURE initialValue ( ) : Key; 19 | 20 | 21 | (* --------------------------------------------------------------------------- 22 | * function Hash.valueForNextChar(hash, ch) 23 | * --------------------------------------------------------------------------- 24 | * Returns the next incremental hash value for incremental hash calculation. 25 | * ------------------------------------------------------------------------ *) 26 | 27 | PROCEDURE valueForNextChar ( hash : Key; ch : CHAR ) : Key; 28 | 29 | 30 | (* --------------------------------------------------------------------------- 31 | * function Hash.finalValue( hash ) 32 | * --------------------------------------------------------------------------- 33 | * Returns the final hash value for incremental hash calculation. 34 | * ------------------------------------------------------------------------ *) 35 | 36 | PROCEDURE finalValue ( hash : Key ) : Key; 37 | 38 | 39 | (* --------------------------------------------------------------------------- 40 | * function Hash.valueForArray( array ) 41 | * --------------------------------------------------------------------------- 42 | * Returns the final hash value for the given character array. 43 | * ------------------------------------------------------------------------ *) 44 | 45 | PROCEDURE valueForArray ( VAR (* CONST *) array : ARRAY OF CHAR ) : Key; 46 | 47 | 48 | END Hash. -------------------------------------------------------------------------------- /src/templates/Infile.gen.def: -------------------------------------------------------------------------------- 1 | (*!m2##ver##*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE Infile; (* ##VER## version *) 4 | 5 | (* I/O library for reading text files with line and column counters *) 6 | 7 | IMPORT SYSTEM, BuildParams, BasicFileIO; 8 | 9 | (*?IMPCAST*) 10 | FROM String IMPORT StringT; (* alias for String.String *) 11 | 12 | 13 | (* --------------------------------------------------------------------------- 14 | * Maximum line length 15 | * ------------------------------------------------------------------------ *) 16 | 17 | CONST MaxLineLength = BuildParams.InfileMaxLineLength; 18 | 19 | 20 | (* --------------------------------------------------------------------------- 21 | * File type for reading 22 | * ------------------------------------------------------------------------ *) 23 | 24 | TYPE Infile; (* OPAQUE *) 25 | 26 | TYPE InfileT = Infile; (* for unqualified use *) 27 | 28 | 29 | (* --------------------------------------------------------------------------- 30 | * Invalid file sentinel 31 | * ------------------------------------------------------------------------ *) 32 | 33 | CONST Nil = (*?TCAST(Infile, NIL)*); (* ##VER## specific *) 34 | 35 | 36 | (* --------------------------------------------------------------------------- 37 | * procedure Open(infile, path, status ) 38 | * --------------------------------------------------------------------------- 39 | * Opens the file at path and passes a newly allocated and initialised infile 40 | * object back in out-parameter infile. Passes NilInfile on failure. 41 | * ------------------------------------------------------------------------ *) 42 | 43 | PROCEDURE Open 44 | ( VAR (* NEW *) infile : Infile; 45 | VAR (* CONST *) path : ARRAY OF CHAR; 46 | VAR status : BasicFileIO.Status ); 47 | 48 | 49 | (* --------------------------------------------------------------------------- 50 | * procedure Close(infile) 51 | * --------------------------------------------------------------------------- 52 | * Closes the file associated with infile and passes NilInfile in infile. 53 | * ------------------------------------------------------------------------ *) 54 | 55 | PROCEDURE Close ( VAR infile : Infile ); 56 | 57 | 58 | (* --------------------------------------------------------------------------- 59 | * procedure consumeChar(infile) 60 | * --------------------------------------------------------------------------- 61 | * Consumes the current lookahead character in infile. Returns the resulting 62 | * new lookahead char without consuming it. 63 | * ------------------------------------------------------------------------ *) 64 | 65 | PROCEDURE consumeChar ( infile : Infile ) : CHAR; 66 | 67 | 68 | (* --------------------------------------------------------------------------- 69 | * procedure lookaheadChar(infile) 70 | * --------------------------------------------------------------------------- 71 | * Returns the current lookahead character in infile without consuming it. 72 | * ------------------------------------------------------------------------ *) 73 | 74 | PROCEDURE lookaheadChar ( infile : Infile ) : CHAR; 75 | 76 | 77 | (* --------------------------------------------------------------------------- 78 | * procedure la2Char(infile) 79 | * --------------------------------------------------------------------------- 80 | * Returns the 2nd lookahead char in infile without consuming any character. 81 | * ------------------------------------------------------------------------ *) 82 | 83 | PROCEDURE la2Char ( infile : Infile ) : CHAR; 84 | 85 | 86 | (* --------------------------------------------------------------------------- 87 | * function status() 88 | * --------------------------------------------------------------------------- 89 | * Returns status of last operation. 90 | * ------------------------------------------------------------------------ *) 91 | 92 | PROCEDURE status ( infile : Infile ) : BasicFileIO.Status; 93 | 94 | 95 | (* --------------------------------------------------------------------------- 96 | * function eof() 97 | * --------------------------------------------------------------------------- 98 | * Returns TRUE if infile has reached the end of the file, else FALSE. 99 | * ------------------------------------------------------------------------ *) 100 | 101 | PROCEDURE eof( infile : Infile ) : BOOLEAN; 102 | 103 | 104 | (* --------------------------------------------------------------------------- 105 | * procedure line(infile) 106 | * --------------------------------------------------------------------------- 107 | * Returns the line number of the current reading position of infile. 108 | * ------------------------------------------------------------------------ *) 109 | 110 | PROCEDURE line ( infile : Infile ) : CARDINAL; 111 | 112 | 113 | (* --------------------------------------------------------------------------- 114 | * procedure column(infile) 115 | * --------------------------------------------------------------------------- 116 | * Returns the column number of the current reading position of infile. 117 | * ------------------------------------------------------------------------ *) 118 | 119 | PROCEDURE column ( infile : Infile ) : CARDINAL; 120 | 121 | 122 | (* --------------------------------------------------------------------------- 123 | * procedure MarkLexeme(infile) 124 | * --------------------------------------------------------------------------- 125 | * Marks the current lookahead character as the start of a lexeme. 126 | * ------------------------------------------------------------------------ *) 127 | 128 | PROCEDURE MarkLexeme( infile : Infile ); 129 | 130 | 131 | (* --------------------------------------------------------------------------- 132 | * procedure lexeme(infile ch) 133 | * --------------------------------------------------------------------------- 134 | * Returns the current lexeme. Returns NIL if no lexeme has been marked, or 135 | * if no characters have been consumed since MarkLexeme() has been called. 136 | * ------------------------------------------------------------------------ *) 137 | 138 | PROCEDURE lexeme ( infile : Infile ) : StringT; 139 | 140 | 141 | END Infile. -------------------------------------------------------------------------------- /xec/LAUNCHSCRIPTS.md: -------------------------------------------------------------------------------- 1 | ### Launch Scripts ### 2 | 3 | There is no way to obtain command line arguments in Modula-2 in a dialect independent way, 4 | nor is it even possible to do so in a portable manner across different operating systems. 5 | 6 | For this reason M2PP reads its command line arguments from a file called `m2ppargs.tmp`. 7 | A small launch script is therefore required that will echo the command line arguments into 8 | this file, then launch M2PP and delete the temporary file again after M2PP has exited. 9 | 10 | This directory contains the launch scripts for different operating systems: 11 | 12 | * `m2pp.sh` for the bash shell used on Unix and Unix-like operating systems 13 | * `m2pp.bat` for the command interpreter on Windows, MS-DOS and OS/2 14 | * `m2pp.com` for the DCL command language on OpenVMS 15 | 16 | A launch script for AmigaOS shall be added in the future. 17 | -------------------------------------------------------------------------------- /xec/m2pp.bat: -------------------------------------------------------------------------------- 1 | REM launch script for m2pp 2 | echo %* > m2ppargs.tmp 3 | m2pp-na 4 | del m2ppargs.tmp 5 | -------------------------------------------------------------------------------- /xec/m2pp.com: -------------------------------------------------------------------------------- 1 | ! m2pp launch script for OpenVMS 2 | open/write outfile m2ppargs.tmp 3 | if p1 .nes. "" then write outfile p1 4 | if p2 .nes. "" then write outfile " ", p2 5 | if p3 .nes. "" then write outfile " ", p3 6 | if p4 .nes. "" then write outfile " ", p4 7 | if p5 .nes. "" then write outfile " ", p5 8 | if p6 .nes. "" then write outfile " ", p6 9 | if p7 .nes. "" then write outfile " ", p7 10 | if p8 .nes. "" then write outfile " ", p8 11 | close outfile 12 | mcr m2pp.exe 13 | delete m2ppargs.tmp;* 14 | -------------------------------------------------------------------------------- /xec/m2pp.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # launch script for m2pp 3 | echo $@ > m2ppargs.tmp 4 | m2pp-na 5 | rm m2ppargs.tmp 6 | --------------------------------------------------------------------------------