├── .gitattributes ├── CONTRIBUTING.md ├── FILES ├── README.md ├── WORKFLOW ├── grammar ├── FIRST.txt ├── FOLLOW.txt ├── m2ast-grammar.gll ├── m2bsk-grammar.gll ├── m2cli-grammar.gll ├── m2fnxlat-grammar.gll ├── m2libconfig-grammar.gll ├── primitive-trie-analysis.txt └── resword-trie-analysis.txt ├── ide-support └── m2bsk.vim ├── src ├── AST.def ├── ArgLexer.def ├── ArgParser.def ├── AstNodeType.def ├── AstQueue.def ├── BuildParams.def ├── CompilerOptions.def ├── DepGraph.def ├── LexQueue.def ├── Lexer.def ├── MatchLex.def ├── ModuleKey.def ├── NonTerminals.def ├── Parser.def ├── Primitive.def ├── Resword.def ├── Symbol.def ├── Token.def ├── TokenSet.16bit.def ├── TokenSet.32bit.def ├── TokenSet.64bit.def ├── imp │ ├── AST.mod │ ├── ArgParser.mod │ ├── AstNodeType.mod │ ├── CompilerOptions.mod │ ├── Lexer.mod │ ├── M2BSK.mod │ ├── MatchLex.mod │ ├── NonTerminals.16bit.mod │ ├── NonTerminals.32bit.mod │ ├── NonTerminals.64bit.mod │ ├── Parser.mod │ ├── Primitive.mod │ ├── Resword.mod │ ├── Token.mod │ ├── TokenSet.16bit.mod │ ├── TokenSet.32bit.mod │ └── TokenSet.64bit.mod └── lib │ ├── AOC.def │ ├── CARD64 │ ├── CARD64.CARDINAL32.def │ ├── CARD64.LONGINT32.def │ ├── Card64BitOps.def │ ├── Card64Math.def │ ├── README.md │ └── imp │ │ ├── CARD64.CARDINAL32.mod │ │ ├── CARD64.LONGINT32.mod │ │ ├── Card64BitOps.CARDINAL32.mod │ │ ├── Card64BitOps.LONGINT32.mod │ │ ├── Card64Math.CARDINAL32.mod │ │ └── Card64Math.LONGINT32.mod │ ├── CardBitOps.def │ ├── CardMath.def │ ├── Char.def │ ├── Hash │ ├── Hash.CARDINAL32.def │ ├── Hash.LONGINT32.def │ ├── LongHash.CARD64.def │ ├── LongHash.LONGINT64.def │ ├── README.md │ └── imp │ │ ├── Hash.CARDINAL32.mod │ │ ├── Hash.LONGINT32.mod │ │ ├── LongHash.CARD64.mod │ │ └── LongHash.LONGINT64.mod │ ├── IO │ ├── BasicFileIO.def │ ├── Console.def │ ├── Consolidate │ │ ├── FileSystem.def │ │ ├── Fileutils.def │ │ ├── SimpleFileIO.def │ │ ├── Source.def │ │ └── imp │ │ │ └── Source.mod │ ├── FilenameXlat.def │ ├── Infile.iso.def │ ├── Infile.pim.def │ ├── Newline.def │ ├── Outfile.iso.def │ ├── Outfile.pim.def │ ├── Tabulator.def │ ├── Terminal.iso.def │ └── imp │ │ ├── Console.mod │ │ ├── Infile.mod │ │ ├── Newline.mod │ │ ├── Tabulator.mod │ │ ├── Terminal.duplicate.iso.mod │ │ └── Terminal.iso.mod │ ├── ISO646.def │ ├── IntBitOps.def │ ├── IntMath.def │ ├── LONGCARD.def │ ├── LongIntBitOps.def │ ├── LongIntMath.def │ ├── Octet.def │ ├── Pathnames │ ├── Pathname.def │ ├── PathnamePolicy.amigaos.def │ ├── PathnamePolicy.default.def │ ├── PathnamePolicy.macos.def │ ├── PathnamePolicy.msdos.def │ ├── PathnamePolicy.openvms.def │ ├── PathnamePolicy.os2.def │ ├── PathnamePolicy.posix.def │ ├── PathnamePolicy.windows.def │ ├── README.md │ └── imp │ │ ├── Pathname.posix.mod │ │ └── Pathname.windows.mod │ ├── String.def │ ├── String.gen.def │ ├── UnsignedInt.def │ ├── imp │ ├── CardBitOps.mod │ ├── CardMath.mod │ ├── Char.mod │ ├── IntBitOps.mod │ ├── LONGCARD.mod │ ├── LongIntBitOps.mod │ ├── String.iso.mod │ └── String.pim.mod │ └── unicode │ ├── Unichar.def │ ├── Unichar.mod │ ├── Unichar0.cardinal32.def │ ├── Unichar0.longint32.def │ ├── Utf8.def │ └── Utf8.mod ├── syntax_diagrams.tcl └── xeq └── LAUNCHSCRIPTS.md /.gitattributes: -------------------------------------------------------------------------------- 1 | *.def linguist-language=modula-2 2 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | ### Modula-2 Compilers ### 2 | 3 | Get yourself a Modula-2 compiler. Some options are ... 4 | 5 | * [ADW Modula-2](https://www.modula2.org/adwm2/download.php) for Windows (freeware) 6 | * [Aglet Modula-2](http://aglet.web.runbox.net/) for AmigaOS (freeware) 7 | * [GNU Modula-2](nongnu.org/gm2/) for Unix systems (open source) 8 | * [GPM Modula-2](https://gpmclr.codeplex.com/) for .NET (open source) 9 | * [MOCKA Modula-2](https://boutell.com/lsm/lsmbyid.cgi/001220) for Linux (freeware) 10 | * [p1 Modula-2](http://modula2.awiedemann.de/) for MacOS (commercial, free demo) 11 | * [XDS Modula-2](https://www.excelsior-usa.com/xds.html) for Linux and Windows (freeware) 12 | 13 | These compilers support either PIM3 or PIM4 or ISO Modula-2, thereby meeting the prerequisites for the project. 14 | 15 | ### Modula-2 Reference Manual ### 16 | 17 | Then get yourself a copy of Niklaus Wirth's "Programming in Modula-2", the reference for classic Modula-2, 18 | available second hand at Amazon for a dollar or two, or thereabouts. Any edition will suffice, the differences are minute. 19 | 20 | * [Wirth, Programming in Modula-2](https://www.amazon.com/Programming-Modula-2-monographs-computer-science/dp/0387122060/ref=sr_1_1?s=books&ie=UTF8&qid=1498585891&sr=1-1&keywords=WIrth+Programming+in+Modula-2) (Amazon.com) 21 | 22 | ### Coding Standard ### 23 | 24 | Please read our coding standard on the project wiki 25 | 26 | https://github.com/m2sf/m2bsk/wiki/Coding-Standard 27 | 28 | ### How to Get in Touch ### 29 | 30 | If you would like to contribute to the project, please get in touch via 31 | 32 | [![Join the chat at https://gitter.im/modula-2/Lobby](https://badges.gitter.im/modula-2/Lobby.svg)](https://gitter.im/modula-2/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) 33 | 34 | or by email 35 | 36 | trijezdci (gmail) 37 | -------------------------------------------------------------------------------- /FILES: -------------------------------------------------------------------------------- 1 | / 2 | /id-support -- third party ide support 3 | /src -- source directory 4 | /src/imp -- implementation directory 5 | FILES -- this file 6 | FIRST.txt -- FIRST sets for all non-terminals 7 | FOLLOW.txt -- FOLLOW sets for all non-terminals 8 | README.md -- project brief 9 | m2bsk-grammar.gll -- Modula-2 LL(1) grammar in EBNF 10 | m2fnxlat-grammar.gll -- filename translation file grammar in EBNF 11 | m2libconfig-grammar.gll -- library configuration file grammar in EBNF 12 | resword-trie-analysis.txt -- Trie analysis for Modula-2 reserved words 13 | 14 | /ide-support 15 | m2bsk.vim -- BSK syntax specification file for VIM 16 | 17 | /src 18 | AOC.def -- CHAR array type definitions for internal use 19 | ASCII.def -- ISO646 character code constant definitions 20 | AST.def -- interface for Abstract Syntax Tree 21 | ArgLexer.def -- interface for command line argument lexer 22 | ArgParser.def -- interface for command line argument parser 23 | AstNodeType.def -- interface for AST node type consistency checks 24 | AstQueue.def -- interface to AST node queue (FIFO) 25 | BuildParams.def -- build parameter definitions 26 | Char.def -- interface for ISO646 character tests and conversions 27 | CardMath.def -- interface to CARDINAL math library 28 | CompilerOptions.def -- interface to compiler option manager 29 | Console.def -- interface to console output library 30 | DepGraph.def -- interface to dependency graph generator 31 | FileSystem.def -- interface to file system 32 | FilenameXlat.def -- interface to filename translation 33 | Fileutils.def -- interface to portable file library 34 | Hash.16bit.def -- interface to 16-bit version of hash function 35 | Hash.32bit.def -- interface to 32-bit version of hash function 36 | Hash.64bit.def -- interface to 64-bit version of hash function 37 | LexQueue.def -- interface to lexeme queue (FIFO) 38 | Lexer.def -- interface to Modula-2 lexer 39 | MatchLex.def -- interface to lexer support library 40 | ModuleKey.def -- interface to module key generator 41 | NonTerminals.def -- interface to FIRST/FOLLOW sets 42 | Parser.def -- interface to Modula-2 parser 43 | Pathname.def -- interface to portable pathname library 44 | PathnamePolicy.amigaos.def -- pathname policy definitions for AmigaOS 45 | PathnamePolicy.macos.def -- pathname policy definitions for MacOS 46 | PathnamePolicy.msdos.def -- pathname policy definitions for MS-DOS 47 | PathnamePolicy.openvms.def -- pathname policy definitions for OpenVMS 48 | PathnamePolicy.os2.def -- pathname policy definitions for OS/2 49 | PathnamePolicy.posix.def -- pathname policy definitions for Unix/POSIX 50 | PathnamePolicy.windows.def -- pathname policy definitions for MS-Windows 51 | PathnamePolicy.default.def -- default pathname policy definitions 52 | SimpleFileIO.def -- interface to File I/O library 53 | Source.def -- interface to source file reader 54 | String.def -- interface to string type 55 | Token.def -- token definitions and interface to token tests 56 | TokenSet.16bit.def -- interface to 16-bit version of token set library 57 | TokenSet.32bit.def -- interface to 32-bit version of token set library 58 | TokenSet.64bit.def -- interface to 64-bit version of token set library 59 | UnsignedInt.def -- PIM compliant unsigned integer definitions 60 | 61 | /imp 62 | ArgLexer.mod -- command line argument lexer 63 | ArgParser.mod -- command line argument parser 64 | CardMath.16bit.mod -- 16-bit version of cardinal math library 65 | CardMath.32bit.mod -- 32-bit version of cardinal math library 66 | CardMath.64bit.mod -- 64-bit version of cardinal math library 67 | Char.mod -- ISO646 character tests and conversions 68 | CompilerOptions.mod -- compiler option manager 69 | Console.mod -- console output library 70 | Hash.16bit.mod -- 16-bit version of general purpose 32-bit hash function 71 | Hash.32bit.mod -- 32-bit version of general purpose 32-bit hash function 72 | Hash.64bit.mod -- 64-bit version of general purpose 32-bit hash function 73 | Lexer.mod -- Modula-2 lexer 74 | MatchLex.mod -- lexer support library 75 | Parser.mod -- Modula-2 parser 76 | Pathname.amigaos.mod -- AmigaOS version of pathname library 77 | Pathname.macos.mod -- MacOS version of pathname library 78 | Pathname.openvms.mod -- OpenVMS version of pathname library 79 | Pathname.posix.mod -- Unix/POSIX version of pathname library 80 | Pathname.windows.mod -- MS-DOS, OS/2 and Windows version of pathname library 81 | Source.mod -- source file reader 82 | Token.mod -- token tests 83 | TokenSet.16bit.mod -- 16-bit version of token set library 84 | TokenSet.32bit.mod -- 32-bit version of token set library 85 | TokenSet.64bit.mod -- 64-bit version of token set library 86 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## M2BSK Modula-2 Bootstrap Kernel Project ## 2 | Welcome to the M2BSK Modula-2 Bootstrap Kernel Project 3 | 4 | ### Objective ### 5 | 6 | The objective of this project is to develop a bootstrap compiler for the revised Modula-2 language described in 7 | 8 | [*Modula-2 Revision 2010, Language Report for the Bootstrap Kernel Subset (BSK)*, by Kowarsch and Sutcliffe, July 2020](https://github.com/m2sf/PDFs/blob/master/M2BSK%20Language%20Description.pdf). 9 | 10 | ### Grammar ### 11 | 12 | The grammar of the compiler's command line interface is in the project repository 13 | 14 | https://github.com/m2sf/m2bsk/blob/master/grammar/m2cli-grammar.gll 15 | 16 | The grammar of the compiler's input language is in the project repository 17 | 18 | https://github.com/m2sf/m2bsk/blob/master/grammar/m2bsk-grammar.gll 19 | 20 | For a graphical representation of the grammar, see section 21 | [Syntax Diagrams](https://github.com/m2sf/m2bsk/wiki/Language-Specification-(D)-:-Syntax-Diagrams). 22 | 23 | ### Language Specification ### 24 | 25 | An online version of the language specification is here: 26 | 27 | https://github.com/m2sf/m2bsk/wiki/Language-Specification 28 | 29 | 30 | The authoritative language specification (PDF) is available for download: 31 | 32 | https://github.com/m2sf/PDFs/blob/master/M2BSK%20Language%20Description.pdf 33 | 34 | 35 | ### Scope ### 36 | 37 | The compiler supports the Bootstrap Kernel (BSK) _**subset**_ of Modula-2 R10. It does not support earlier PIM or ISO dialects. 38 | 39 | For a list of facilities that have been omitted in the subset, see [Omissions](https://github.com/m2sf/m2bsk/wiki/Omissions) 40 | 41 | ### Targets ### 42 | 43 | The compiler will generate classic Modula-2 sources that can be compiled with any Modula-2 compiler that meets the prerequisites for compiling M2BSK itself. An LLVM backend will be added later to generate [LLVM IR](http://llvm.org/docs/LangRef.html). 44 | 45 | ### License ### 46 | 47 | M2BSK is licensed under the GNU Lesser General Public License (LGPL) both v.2.1 and v.3. 48 | 49 | ### Prerequisites ### 50 | 51 | M2BSK is written in a subset of the third and fourth editions of Niklaus Wirth's "Programming in Modula-2" that represents an intersection with ISO Modula-2 (IS 10514-1) in order to facilitate compilation with any classic Modula-2 compiler, regardless of dialect and platform. 52 | 53 | Nevertheless, the host compiler needs to support **one** of the following memory models: 54 | 55 | * 16-bit `CARDINAL` type and 32-bit `LONGINT` type 56 | * 32-bit `CARDINAL` type and 32-bit `LONGINT` type 57 | * 32-bit `CARDINAL` type and 64-bit `LONGINT` type 58 | 59 | Furthermore, the following libraries from Wirth's "Programming in Modula-2" are required. 60 | 61 | * Storage 62 | * Terminal 63 | * FileSystem 64 | 65 | These libraries should be part of any PIM Modula-2 compiler's library. For use with ISO Modula-2 compilers, M2BSK provides shim libraries for adaptation to ISO Modula-2 libraries. 66 | 67 | **There are no dependencies on any third party libraries.** 68 | 69 | ### OS support ### 70 | 71 | M2BSK will run on any operating system with target support by the host-compiler. 72 | 73 | ### Development Languages ### 74 | 75 | * M2BSK itself is written in classic Modula-2 76 | * The syntax diagram generator script is written in TCL/TK (not required to build M2BSK) 77 | * Build configuration scripts are written in the prevalent shell language of the hosting platform 78 | 79 | ### Contact ### 80 | 81 | If you have questions or would like to contribute to the project, get in touch via 82 | 83 | * [Modula2 Telegram group](https://t.me/+hTKSWC2mWoM1OGVl) chat 84 | 85 | * [email](mailto:REMOVE+REVERSE.com.gmail@trijezdci) to the project maintainer 86 | 87 | +++ 88 | -------------------------------------------------------------------------------- /WORKFLOW: -------------------------------------------------------------------------------- 1 | Compilation Workflow 2 | 3 | launch-script 4 | ------------- 5 | * collect command line arguments 6 | * write arguments to argument file 7 | * invoke compiler 8 | * delete arg file 9 | 10 | compiler 11 | -------- 12 | * read and evaluate argument file 13 | * store arguments 14 | * if information request 15 | * print information 16 | * exit 17 | * if compilation request 18 | * read and evaluate configuration file 19 | * store configuration 20 | * determine module dependencies 21 | * write DEP file 22 | * determine compilation order from dependencies 23 | * for each module 24 | * perform lexical analysis and tokenisation 25 | * perform syntax analysis and build AST node 26 | * perform static semantic analysis 27 | * write AST file (S-expr representation) 28 | * write DOT file (graphical representation) 29 | * if definition module 30 | * write SYM file 31 | * write PIM/ISO DEF file 32 | * if implementation module 33 | * check consistency with corresponding SYM file 34 | * generate code from AST by template expansion 35 | * write PIM/ISO MOD file 36 | * invoke PIM/ISO compiler passing generated DEF or MOD file 37 | * purge unwanted intermediary files 38 | * determine and print statistics 39 | * exit 40 | -------------------------------------------------------------------------------- /grammar/m2ast-grammar.gll: -------------------------------------------------------------------------------- 1 | /* M2AST -- EBNF Grammar for Abstract Syntax Tree S-Expressions. */ 2 | * 3 | * Copyright (c) 2020 The Modula-2 Software Foundation 4 | * 5 | * Author & Maintainer: Benjamin Kowarsch 6 | * 7 | * @synopsis 8 | * 9 | * This document describes the grammar of AST S-Expressions. 10 | * 11 | * @repository 12 | * 13 | * https://github.com/m2sf/m2bsk 14 | * 15 | * @file 16 | * 17 | * m2ast-grammar.gll 18 | * 19 | * Grammar of AST S-Expressions. 20 | * 21 | */ 22 | 23 | grammar m2ast; 24 | 25 | reserved 26 | COMPUNIT, FILENAME, COMPILED, DIGEST, DEFMOD, IMPMOD, PROGRAM, 27 | ID, IMPORT, REEXPORT, CONST, VAR, TYPE, PROC, BIND, ALIAS, 28 | ENUM, SET, ARRAY, RECORD, POINTER, OPAQUE, FIELD, FT, FP, 29 | CONSTP, VARP, ARRAYP, CASTSEQ, CASTPTR 30 | /* incomplete */ 31 | ; 32 | 33 | compilationUnit := 34 | '(' COMPUNIT filenameNode timestampNode digestNode moduleNode ')' 35 | ; 36 | 37 | filenameNode := 38 | '(' FILENAME quotedLiteral ')' 39 | ; 40 | 41 | timestampNode := 42 | '(' COMPILED quotedLiteral ')' 43 | ; 44 | 45 | digestNode := 46 | '(' DIGEST quotedLiteral ')' 47 | ; 48 | 49 | moduleNode := 50 | defModNode | impModNode | progNode 51 | ; 52 | 53 | defModNode := 54 | '(' DEFMOD idNode importNode* reExportNode* declarationNode* ')' 55 | ; 56 | 57 | idNode := 58 | '(' ID quotedLiteral ')' 59 | ; 60 | 61 | importNode := 62 | '(' IMPORT quotedLiteral+ ')' 63 | ; 64 | 65 | reExportNode := 66 | '(' REEXPORT quotedLiteral+ ')' 67 | ; 68 | 69 | declarationNode := 70 | constDeclNode | varDeclNode | typeDeclNode | procDeclNode 71 | ; 72 | 73 | constDeclNode := 74 | '(' CONST idNode exprNode typeIdNode? ')' 75 | ; 76 | 77 | alias typeIdNode = idNode ; 78 | 79 | varDeclNode := 80 | '(' VAR idListNode typeIdNode ')' 81 | ; 82 | 83 | idListNode := 84 | '(' ID quotedLiteral+ ')' 85 | ; 86 | 87 | typeDeclNode := 88 | '(' TYPE idNode typeConstructorNode ')' 89 | ; 90 | 91 | typeConstructorNode := 92 | aliasTypeNode | derivedTypeNode | subrangeTypeNode |enumTypeNode | 93 | setTypeNode | arrayTypeNode | recordTypeNode | pointerTypeNode | 94 | opaqueTypeNode | procTypeNode 95 | ; 96 | 97 | aliasTypeNode := 98 | '(' ALIAS baseTypeNode ')' 99 | ; 100 | 101 | alias baseTypeNode = typeIdNode ; 102 | 103 | alias derivedTypeNode = typeIdNode ; 104 | 105 | subrangeTypeNode := 106 | '(' SUBR baseTypeNode lowerBound upperBound ')' 107 | ; 108 | 109 | alias lowerBound, upperBound = exprNode ; 110 | 111 | enumTypeNode := 112 | '(' ENUM baseTypeNode valueListNode ')' 113 | ; 114 | 115 | alias valueListNode = idListNode ; 116 | 117 | setTypeNode := 118 | '(' SET enumTypeIdNode ')' 119 | ; 120 | 121 | alias enumTypeIdNode = typeIdNode ; 122 | 123 | arrayTypeNode := 124 | '(' ARRAY capacity baseTypeNode ')' 125 | ; 126 | 127 | alias capacity = exprNode ; 128 | 129 | recordTypeNode := 130 | '(' RECORD baseTypeNode fieldListNode* ')' 131 | ; 132 | 133 | fieldListNode := 134 | '(' FIELD idListNode fieldTypeNode ')' 135 | ; 136 | 137 | fieldTypeNode := 138 | typeIdNode | arrayTypeNode | pointerTypeNode | procTypeNode 139 | ; 140 | 141 | pointerTypeNode := 142 | '(' POINTER targetTypeIdNode ')' 143 | ; 144 | 145 | alias targetTypeIdNode = typeIdNode; 146 | 147 | opaqueTypeNode := 148 | '(' OPAQUE ( allocSize | NIL ) ')' 149 | 150 | alias allocSize = exprNode ; 151 | 152 | procTypeNode := 153 | '(' PROCSIG formalTypeList returnTypeNode ')' 154 | ; 155 | 156 | formalTypeList := 157 | formalTypeNode+ | NIL 158 | ; 159 | 160 | formalTypeNode := 161 | '(' FT attrNode? idListNode+ structNode? typeIdNode ')' 162 | ; 163 | 164 | attrNode := 165 | '(' ( CONSTP | VARP ) ')' 166 | ; 167 | 168 | structNode := 169 | '(' ( ARRAYP | ARGLIST | CASTSEQ | CASTPTR ) ')' 170 | ; 171 | 172 | returnTypeNode := 173 | '(' RTN typeIdNode ')' | NIL 174 | ; 175 | 176 | procDeclNode := 177 | '(' PROC formalParamList returnTypeNode ')' 178 | ; 179 | 180 | formalParamList := 181 | formalParamNode+ | NIL 182 | ; 183 | 184 | formalParamNode := 185 | '(' FP attrNode idListNode+ structNode typeIdNode ')' 186 | ; 187 | 188 | bindDeclNode := 189 | '( BIND idToBind targetToBindTo ')' 190 | ; 191 | 192 | alias idToBind, targetToBindTo = idNode ; 193 | 194 | 195 | /* incomplete */ 196 | 197 | 198 | end m2ast. 199 | -------------------------------------------------------------------------------- /grammar/m2cli-grammar.gll: -------------------------------------------------------------------------------- 1 | /* M2BSK -- EBNF Grammar for Modula-2 R10 Bootstrap Kernel (subset). 2 | * 3 | * Copyright (c) 2017 The Modula-2 Software Foundation 4 | * 5 | * Author & Maintainer: Benjamin Kowarsch 6 | * 7 | * @synopsis 8 | * 9 | * Modula-2 BSK is a subset of Modula-2 R10 for bootstrapping a compiler. 10 | * 11 | * This document specifies the command line argument grammar in EBNF. 12 | * 13 | * @repository 14 | * 15 | * https://github.com/m2sf/m2bsk 16 | * 17 | * @file 18 | * 19 | * m2cli-grammar.gll 20 | * 21 | * Grammar of Modula-2 command line interface. 22 | * 23 | */ 24 | 25 | grammar m2cli; 26 | 27 | /* * * R e s e r v e d W o r d s * * */ 28 | 29 | /* to do */ 30 | 31 | 32 | /* * * N o n - T e r m i n a l S y m b o l s * * */ 33 | 34 | args := 35 | infoRequest | compilationRequest 36 | ; 37 | 38 | infoRequest := 39 | --help | -h | --version | -V | --license 40 | ; 41 | 42 | compilationRequest := 43 | products? capabilities? sourceFile diagnostics? 44 | ; 45 | 46 | products := 47 | ( singleProduct | multipleProducts ) commentOption? 48 | ; 49 | 50 | singleProduct := 51 | --syntax-only | --ast-only | --graph-only | --xlat-only | --obj-only 52 | ; 53 | 54 | multipleProducts := 55 | ( ast | graph | xlat | obj )+ 56 | ; 57 | 58 | ast := 59 | --ast | --no-ast 60 | ; 61 | 62 | graph := 63 | --graph | --no-graph 64 | ; 65 | 66 | xlat := 67 | --xlat | --no-xlat 68 | ; 69 | 70 | obj := 71 | --obj | --no-obj 72 | ; 73 | 74 | commentOption := 75 | --preserve-comments | --strip-comments 76 | ; 77 | 78 | capabilities := 79 | /* this should be simplified to a simple switch --foreign-identifiers */ 80 | ( dollarIdentifiers | lowlineIdentifiers )+ 81 | ; 82 | 83 | sourceFile := 84 | 85 | ; 86 | 87 | diagnostics := 88 | ( --verbose | -v | --lexer-debug | --parser-debug | --print-settings | 89 | --errant-semicolons )+ 90 | ; 91 | 92 | 93 | /* * * T e r m i n a l S y m b o l s * * */ 94 | 95 | 96 | QuotedLiteral := 97 | SingleQuotedString | DoubleQuotedString 98 | ; 99 | 100 | .SingleQuotedString := 101 | "'" ( QuotableCharacter | '"' )* "'" 102 | ; 103 | 104 | .DoubleQuotedString := 105 | '"' ( QuotableCharacter | "'" )* '"' 106 | ; 107 | 108 | .QuotableCharacter := 109 | Digit | Letter | Space | NonAlphanumQuotable 110 | ; 111 | 112 | .Digit := '0' .. '9' ; 113 | 114 | .Letter := 'a' .. 'z' | 'A' .. 'Z' ; 115 | 116 | .Space := 0u20 ; 117 | 118 | .NonAlphaNumQuotable := 119 | '!' | '#' | '$' | '%' | '&' | '(' | ')' | '*' | '+' | ',' | 120 | '-' | '.' | '/' | ':' | ';' | '<' | '=' | '>' | '?' | '@' | 121 | '[' | '\' | ']' | '^' | '_' | '`' | '{' | '|' | '}' | '~' 122 | ; 123 | 124 | endg m2cli. 125 | -------------------------------------------------------------------------------- /grammar/m2fnxlat-grammar.gll: -------------------------------------------------------------------------------- 1 | /* M2BSK -- EBNF Grammar for Modula-2 R10 Bootstrap Kernel (subset). 2 | * 3 | * Copyright (c) 2017 The Modula-2 Software Foundation 4 | * 5 | * Author & Maintainer: Benjamin Kowarsch 6 | * 7 | * @synopsis 8 | * 9 | * Modula-2 BSK is a subset of Modula-2 R10 for bootstrapping a compiler. 10 | * 11 | * This document specifies the filename translation file grammar in EBNF. 12 | * 13 | * @repository 14 | * 15 | * https://github.com/m2sf/m2bsk 16 | * 17 | * @file 18 | * 19 | * m2fnxlat-grammar.gll 20 | * 21 | * Grammar of filename translation file. 22 | * 23 | */ 24 | 25 | grammar m2fnxlat; 26 | 27 | /* * * N o n - T e r m i n a l S y m b o l s * * */ 28 | 29 | dictionary := 30 | translation ( ',' translation )* ';' 31 | ; 32 | 33 | translation := 34 | moduleIdent '=' ActualBasename 35 | ; 36 | 37 | alias moduleIdent = StdIdent ; 38 | 39 | 40 | /* * * T e r m i n a l S y m b o l s * * */ 41 | 42 | StdIdent := 43 | Letter ( Letter | Digit )* 44 | ; 45 | 46 | ActualBasename := 47 | StdIdent ( '-' Digit Digit )? '.*' 48 | ; 49 | 50 | .Digit := '0' .. '9' ; 51 | 52 | .Letter := 'a' .. 'z' | 'A' .. 'Z' ; 53 | 54 | 55 | endg m2fnxlat. 56 | -------------------------------------------------------------------------------- /grammar/m2libconfig-grammar.gll: -------------------------------------------------------------------------------- 1 | /* M2BSK -- EBNF Grammar for Modula-2 R10 Bootstrap Kernel (subset). 2 | * 3 | * Copyright (c) 2017 The Modula-2 Software Foundation 4 | * 5 | * Author & Maintainer: Benjamin Kowarsch 6 | * 7 | * @synopsis 8 | * 9 | * Modula-2 BSK is a subset of Modula-2 R10 for bootstrapping a compiler. 10 | * 11 | * This document specifies the library configuration file grammar in EBNF. 12 | * 13 | * @repository 14 | * 15 | * https://github.com/m2sf/m2bsk 16 | * 17 | * @file 18 | * 19 | * m2libconfig-grammar.gll 20 | * 21 | * Grammar of Modula-2 library configuration file. 22 | * 23 | */ 24 | 25 | grammar m2libconfig; 26 | 27 | /* * * R e s e r v e d W o r d s * * */ 28 | 29 | reserved 30 | STDLIB = 'stdlib', USRLIBS = 'usrlibs'; 31 | 32 | 33 | /* * * N o n - T e r m i n a l S y m b o l s * * */ 34 | 35 | libConfig := 36 | stdlibConfig usrlibConfig 37 | ; 38 | 39 | stdlibConfig := 40 | STDLIB '=' pathList ';' 41 | ; 42 | 43 | usrlibConfig := 44 | USRLIBS '=' pathList ';' 45 | ; 46 | 47 | pathList := 48 | path ( ',' path )* 49 | ; 50 | 51 | alias path = QuotedLiteral; 52 | 53 | 54 | /* * * T e r m i n a l S y m b o l s * * */ 55 | 56 | 57 | QuotedLiteral := 58 | SingleQuotedString | DoubleQuotedString 59 | ; 60 | 61 | .SingleQuotedString := 62 | "'" ( QuotableCharacter | '"' )* "'" 63 | ; 64 | 65 | .DoubleQuotedString := 66 | '"' ( QuotableCharacter | "'" )* '"' 67 | ; 68 | 69 | .QuotableCharacter := 70 | Digit | Letter | Space | NonAlphanumQuotable 71 | ; 72 | 73 | .Digit := '0' .. '9' ; 74 | 75 | .Letter := 'a' .. 'z' | 'A' .. 'Z' ; 76 | 77 | .Space := 0u20 ; 78 | 79 | .NonAlphaNumQuotable := 80 | '!' | '#' | '$' | '%' | '&' | '(' | ')' | '*' | '+' | ',' | 81 | '-' | '.' | '/' | ':' | ';' | '<' | '=' | '>' | '?' | '@' | 82 | '[' | '\' | ']' | '^' | '_' | '`' | '{' | '|' | '}' | '~' 83 | ; 84 | 85 | endg m2libconfig. 86 | -------------------------------------------------------------------------------- /grammar/primitive-trie-analysis.txt: -------------------------------------------------------------------------------- 1 | Primitive Trie Analysis 2 | 3 | Length=6 4 | 5 | 0 1 2 3 4 5 6 | _|A|L|L|O|C 7 | _|S|T|D|I|N 8 | ---------- 9 | 1 0 0 0 0 0 10 | * 11 | 12 | 13 | Length=7 14 | 15 | 0 1 2 3 4 5 6 16 | _|K|V|A|L|U|E 17 | _|S|T|D|O|U|T 18 | ------------- 19 | 1 0 0 0 0 1 0 20 | * 21 | 22 | 23 | Length=8 24 | 25 | 0 1 2 3 4 5 6 7 26 | _|A|T|S|T|O|R|E 27 | _|A|T|V|A|L|U|E 28 | _|D|E|A|L|L|O|C 29 | _|K|V|S|T|O|R|E 30 | --------------- 31 | 3 2 1 1 1 2 1 2 32 | * 33 | 34 | 35 | Length=9 36 | 37 | 0 1 2 3 4 5 6 7 8 38 | _|A|T|I|N|S|E|R|T 39 | _|A|T|R|E|M|O|V|E 40 | ----------------- 41 | 1 1 1 0 0 0 0 0 0 42 | * 43 | 44 | END OF FILE 45 | -------------------------------------------------------------------------------- /grammar/resword-trie-analysis.txt: -------------------------------------------------------------------------------- 1 | Reserved Word Trie Analysis 2 | 3 | Length=2 4 | 5 | 0 1 6 | D|O 7 | I|F 8 | I|N 9 | O|F 10 | O|R 11 | T|O 12 | --- 13 | 2 2 14 | * 15 | 16 | 17 | Length=3 18 | 19 | 0 1 2 20 | A|N|D 21 | D|I|V 22 | E|N|D 23 | F|O|R 24 | M|O|D 25 | N|E|W 26 | N|O|P 27 | N|O|T 28 | S|E|T 29 | V|A|R 30 | ----- 31 | 2 4 4 32 | * 33 | 34 | 35 | Length=4 36 | 37 | 0 1 2 3 38 | C|A|S|E 39 | C|O|P|Y 40 | E|L|S|E 41 | E|X|I|T 42 | L|O|O|P 43 | R|E|A|D 44 | T|H|E|N 45 | T|Y|P|E 46 | ------- 47 | 3 1 1 2 48 | * 49 | 50 | 51 | Length=5 52 | 53 | 0 1 2 3 4 54 | A|L|I|A|S 55 | A|R|R|A|Y 56 | B|E|G|I|N 57 | C|O|N|S|T 58 | E|L|S|I|F 59 | U|N|T|I|L 60 | W|H|I|L|E 61 | W|R|I|T|E 62 | --------- 63 | 2 2 2 3 1 64 | * 65 | 66 | 67 | Length=6 68 | 69 | 0 1 2 3 4 5 70 | I|M|P|O|R|T 71 | M|O|D|U|L|E 72 | O|P|A|Q|U|E 73 | R|E|C|O|R|D 74 | R|E|P|E|A|T 75 | R|E|T|A|I|N 76 | R|E|T|U|R|N 77 | ----------- 78 | 3 3 2 2 2 2 79 | * 80 | 81 | 82 | Length=7 83 | 84 | 0 1 2 3 4 5 6 85 | A|R|G|L|I|S|T 86 | P|O|I|N|T|E|R 87 | R|E|L|E|A|S|E 88 | ------------- 89 | 0 0 0 0 0 1 0 90 | * 91 | 92 | 93 | Length=8 94 | 95 | 0 1 2 3 4 5 6 7 96 | O|C|T|E|T|S|E|Q 97 | --------------- 98 | 0 0 0 0 0 0 0 0 99 | * 100 | 101 | 102 | Length=9 103 | 104 | 0 1 2 3 4 5 6 7 8 105 | P|R|O|C|E|D|U|R|E 106 | ----------------- 107 | 0 0 0 0 0 0 0 0 0 108 | * 109 | 110 | 111 | Length=10 112 | 113 | 0 1 2 3 4 5 6 7 8 9 114 | D|E|F|I|N|I|T|I|O|N 115 | ------------------- 116 | 0 0 0 0 0 0 0 0 0 0 117 | * 118 | 119 | 120 | Length=11 121 | 122 | 0 1 2 3 4 5 6 7 8 9 0 123 | U|N|Q|U|A|L|I|F|I|E|D 124 | --------------------- 125 | 0 0 0 0 0 0 0 0 0 0 0 126 | * 127 | 128 | 129 | Length=14 130 | 131 | 0 1 2 3 4 5 6 7 8 9 0 1 2 3 132 | I|M|P|L|E|M|E|N|T|A|T|I|O|N 133 | --------------------------- 134 | 0 0 0 0 0 0 0 0 0 0 0 0 0 0 135 | * 136 | 137 | END OF FILE 138 | -------------------------------------------------------------------------------- /src/AST.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2016 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE AST; 4 | 5 | (* AST for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM AstQueue IMPORT AstQueueT; 8 | FROM LexQueue IMPORT LexQueueT; 9 | FROM AstNodeType IMPORT AstNodeTypeT; 10 | 11 | TYPE AST; (* OPAQUE *) 12 | 13 | TYPE AstT = AST; (* for unqualified use *) 14 | 15 | 16 | (* Operations *) 17 | 18 | PROCEDURE NewUnaryNode 19 | ( VAR ast : AST; nodeType : AstNodeTypeT; subnode : AST ); 20 | (* Allocates a new branch node of the given node type, stores the given 21 | subnode in node and passes back node, or NIL on failure. *) 22 | 23 | PROCEDURE NewBinaryNode 24 | ( VAR ast : AST; nodeType : AstNodeTypeT; subnode1, subnode2 : AST ); 25 | (* Allocates a new branch node of the given node type, stores the given 26 | subnodes in node and passes back node, or NIL on failure. *) 27 | 28 | PROCEDURE New3aryNode 29 | ( VAR ast : AST; 30 | nodeType : AstNodeTypeT; subnode1, subnode2, subnode3 : AST ); 31 | (* Allocates a new branch node of the given node type, stores the given 32 | subnodes in node and passes back node, or NIL on failure. *) 33 | 34 | PROCEDURE New4aryNode 35 | ( VAR ast : AST; 36 | nodeType : AstNodeTypeT; subnode1, subnode2, subnode3, subnode4 : AST ); 37 | (* Allocates a new branch node of the given node type, stores the given 38 | subnodes in node and passes back node, or NIL on failure. *) 39 | 40 | PROCEDURE New5aryNode 41 | ( VAR ast : AST; 42 | nodeType : AstNodeTypeT; 43 | subnode1, subnode2, subnode3, subnode4, subnode5 : AST ); 44 | (* Allocates a new branch node of the given node type, stores the given 45 | subnodes in node and passes back node, or NIL on failure. *) 46 | 47 | PROCEDURE NewListNode 48 | ( VAR ast : AST; nodeType : AstNodeTypeT; subnodes : AstQueueT ); 49 | (* Allocates a new branch node of the given node type, stores the subnodes of 50 | * the given node queue in the node and passes back node, or NIL on failure. *) 51 | 52 | PROCEDURE NewTerminalNode 53 | ( VAR ast : AST; nodeType : AstNodeTypeT; value : LexemeT ); 54 | (* Allocates a new terminal node of the given node type, stores the given 55 | value in the node and passes back node, or NIL on failure. *) 56 | 57 | PROCEDURE NewTerminalListNode 58 | ( VAR ast : AST; nodeType : AstNodeTypeT; values : LexQueueT ); 59 | (* Allocates a new terminal node of the given node type, stores the values of 60 | the given value queue in the node and passes node, or NIL on failure. *) 61 | 62 | PROCEDURE nodeType ( node : AST ) : AstNodeTypeT; 63 | (* Returns the node type of node, or AST.Invalid if node is NIL. *) 64 | 65 | PROCEDURE subnodeCount ( node : AST ) : CARDINAL; 66 | (* Returns the number of subnodes or values of node. *) 67 | 68 | PROCEDURE subnodeForIndex ( node : AST; index : CARDINAL ) : AST; 69 | (* Returns the subnode of node with the given index or NIL if no subnode of 70 | the given index is stored in node. *) 71 | 72 | PROCEDURE valueForIndex ( node : AST; index : CARDINAL ) : LexemeT; 73 | (* Returns the value stored at the given index in a terminal node, 74 | * or NIL if the node does not store any value at the given index. *) 75 | 76 | PROCEDURE value ( node : AST ) : LexemeT; 77 | (* Calls function valueForIndex with an index of zero. *) 78 | 79 | PROCEDURE replaceSubnode 80 | ( node : AST; atIndex : CARDINAL; withSubnode : AST ) : AST; 81 | (* Replaces a subnode and returns the replaced node, or NIL on failure. *) 82 | 83 | PROCEDURE replaceValue 84 | ( node : AST; atIndex : CARDINAL; withValue : LexemeT ) : LexemeT; 85 | (* Replaces a subnode and returns the replaced value, or NIL on failure. *) 86 | 87 | PROCEDURE Release ( VAR ast : AST ); 88 | (* Releases ast and passes back NIL if successful. *) 89 | 90 | 91 | END AST. 92 | -------------------------------------------------------------------------------- /src/ArgParser.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2016 B.Kowarsch. All rights reserved. *) 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 | ErrorsEncountered); 16 | 17 | 18 | (* --------------------------------------------------------------------------- 19 | * function parseArgs() 20 | * --------------------------------------------------------------------------- 21 | * Parses command line arguments and sets compiler options accordingly. 22 | * ------------------------------------------------------------------------ *) 23 | 24 | PROCEDURE parseArgs : Status; 25 | 26 | 27 | (* --------------------------------------------------------------------------- 28 | * function sourceFile() 29 | * --------------------------------------------------------------------------- 30 | * Returns a string with the source file argument. 31 | * ------------------------------------------------------------------------ *) 32 | 33 | PROCEDURE sourceFile : StringT; 34 | 35 | 36 | (* --------------------------------------------------------------------------- 37 | * function errorCount() 38 | * --------------------------------------------------------------------------- 39 | * Returns the count of errors encountered while parsing the arguments. 40 | * ------------------------------------------------------------------------ *) 41 | 42 | PROCEDURE errorCount : CARDINAL; 43 | 44 | 45 | END ArgParser. 46 | -------------------------------------------------------------------------------- /src/AstNodeType.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015, 2020 Modula-2 Software Foundation *) 2 | 3 | DEFINITION MODULE AstNodeType; 4 | 5 | (* AST Node Type Definitions for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | 8 | FROM String IMPORT StringT; 9 | 10 | 11 | (* AST Node Type *) 12 | 13 | TYPE AstNodeType = 14 | ( Invalid, 15 | 16 | (* Arity-0 Nodes *) 17 | 18 | Empty, (* empty node sentinel *) 19 | Exit, (* EXIT statement node type *) 20 | Nop, (* NOP statement node type *) 21 | 22 | (* Arity-1 Nodes *) 23 | 24 | Alias, (* alias type node *) 25 | Set, (* set type constructor node *) 26 | Pointer, (* pointer type node *) 27 | Unq, (* unqualified alias node *) 28 | 29 | Loop, (* loop statement node *) 30 | 31 | Neg, (* arithmetic negation sub-expression node *) 32 | Not, (* logical negation sub-expression node *) 33 | 34 | Filename, (* filename node *) 35 | Compiled, (* timestamp node *) 36 | Digest, (* module digest node *) 37 | Ident, (* identifier node *) 38 | Qualident, (* qualified identifier node *) 39 | IntVal, (* whole number value node *) 40 | RealVal, (* real number value node *) 41 | ChrVal, (* character code value node *) 42 | QuotedVal, (* quoted literal value node *) 43 | 44 | (* Arity-2 Nodes *) 45 | 46 | VarDecl, (* variable declaration node *) 47 | TypeDecl, (* type declaration node *) 48 | Array, (* array type constructor node *) 49 | Enum, (* enumeration type constructor node *) 50 | ProcType, (* procedure type constructor node *) 51 | Field, (* field list node *) 52 | Proc, (* procedure declaration node *) 53 | Bind, (* binding declaration node *) 54 | 55 | PCall, (* procedure call node *) 56 | While, (* while statement node *) 57 | Repeat, (* repeat statement node *) 58 | Range, (* expression range node *) 59 | 60 | Eq, (* equality sub-expression node *) 61 | Neq, (* inequality sub-expression node *) 62 | Lt, (* less-than sub-expression node *) 63 | LtEq, (* less-than-or-equal sub-expression node *) 64 | Gt, (* greater-than sub-expression node *) 65 | GtEq, (* greater-than-or-equal sub-expression node *) 66 | In, (* set membership sub-expression node *) 67 | Plus, (* plus sub-expression node *) 68 | Minus, (* minus sub-expression node *) 69 | Or, (* logical disjunction sub-expression node *) 70 | Star, (* asterisk sub-expression node *) 71 | Slash, (* solidus sub-expression node *) 72 | Div, (* integer division sub-expression node *) 73 | Mod, (* modulus sub-expression node *) 74 | And, (* logical conjunction expression node *) 75 | FCall, (* function call node *) 76 | 77 | (* Arity-3 Nodes *) 78 | 79 | Subr, (* subrange type constructor node *) 80 | 81 | (* Arity-4 Nodes *) 82 | 83 | CompUnit, (* compilation unit node *) 84 | 85 | (* Arity-5 Nodes *) 86 | 87 | 88 | (* Variadic Nodes *) 89 | 90 | DefMod, (* definition module node *) 91 | ImpMod, (* implementation module node *) 92 | Program, (* program node *) 93 | 94 | Import, (* import list node *) 95 | Reexport, (* re-export list node *) 96 | StmtSeq, (* statement sequence node *) 97 | ExprList, (* expression list node *) 98 | 99 | IdentList, (* identifier list node *) 100 | QualidentList ); (* qualified identifier list node *) 101 | 102 | 103 | TYPE AstNodeTypeT = AstNodeType; (* for unqualified use *) 104 | 105 | 106 | (* Subranges by Arity *) 107 | 108 | (* Arity-0 Subrange *) 109 | 110 | TYPE Arity0 = AstNodeType [Empty .. Nop]; 111 | 112 | (* Arity-1 Subrange *) 113 | 114 | TYPE Arity1 = AstNodeType [Alias .. Not]; 115 | 116 | (* Arity-2 Subrange *) 117 | 118 | TYPE Arity2 = AstNodeType [VarDecl .. And]; 119 | 120 | (* Arity-3 Subrange *) 121 | 122 | TYPE Arity3 = AstNodeType [Subr .. Subr]; 123 | 124 | (* Arity-4 Subrange *) 125 | 126 | TYPE Arity4 = AstNodeType [CompUnit .. ]; 127 | 128 | (* Arity-5 Subrange *) 129 | 130 | TYPE Arity5 = AstNodeType [ .. ]; 131 | 132 | (* Variadic Subrange *) 133 | 134 | TYPE Variadic = AstNodeType [DefMod .. ExprList]; 135 | 136 | (* Module Subrange *) 137 | 138 | TYPE Modules = AstNodeType [DefMod .. Program]; 139 | 140 | 141 | (* Arity-1 Terminal Subrange *) 142 | 143 | TYPE Terminal1 = AstNodeType [Filename .. QuotedVal]; 144 | 145 | (* Variadic Terminal Subrange *) 146 | 147 | TYPE TerminalN = AstNodeType [IdentList .. QualidentList]; 148 | 149 | 150 | (* Category Tests *) 151 | 152 | PROCEDURE isNonTerminal ( t : AstNodeType ) : BOOLEAN; 153 | (* Returns TRUE if t is a non-terminal node type, otherwise FALSE. *) 154 | 155 | PROCEDURE isTerminal ( t : AstNodeType ) : BOOLEAN; 156 | (* Returns TRUE if t is a terminal node type, otherwise FALSE. *) 157 | 158 | 159 | (* Presentation *) 160 | 161 | PROCEDURE name ( t : AstNodeType ) : StringT; 162 | (* Returns a human readable name for node type t. *) 163 | 164 | 165 | END AstNodeType. -------------------------------------------------------------------------------- /src/AstQueue.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE AstQueue; 4 | 5 | (* AST Node Queue for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM AST IMPORT AstT; 8 | 9 | 10 | TYPE AstQueue; (* OPAQUE *) 11 | 12 | TYPE AstQueueT = AstQueue; (* for unqualified use *) 13 | 14 | 15 | (* Operations *) 16 | 17 | PROCEDURE New ( VAR queue : AstQueue ); 18 | (* Allocates a new empty queue object and passes it back in queue. 19 | Passes NIL if the allocation failed. *) 20 | 21 | PROCEDURE enqueue ( queue : AstQueue; node : AstT ) : Queue; 22 | (* Adds node to the head of queue and returns queue, or NIL on failure. *) 23 | 24 | PROCEDURE enqueueUnique ( queue : AstQueue; node : AstT ) : Queue; 25 | (* Adds node to the head of queue if and only if the value is not already 26 | * present in queue. Returns queue on success, or NIL on failure. *) 27 | 28 | PROCEDURE dequeue ( queue : AstQueue ) : AstT; 29 | (* Removes the node at the tail of queue and returns it, or NIL on failure. *) 30 | 31 | PROCEDURE isEmpty ( queue : AstQueue ) : BOOLEAN; 32 | (* Returns TRUE if queue is empty, otherwise FALSE. *) 33 | 34 | PROCEDURE isElem ( queue : AstQueue; node : AstT ) : BOOLEAN; 35 | (* Returns TRUE if node is stored in queue, otherwise FALSE. *) 36 | 37 | PROCEDURE count ( queue : AstQueue ) : CARDINAL; 38 | (* Returns the number of nodes in queue. *) 39 | 40 | PROCEDURE Reset ( queue : AstQueue ) : AstT; 41 | (* Removes all nodes from queue but does not deallocate it. 42 | Returns queue on success, or NIL if queue is NIL. *) 43 | 44 | PROCEDURE Release ( VAR queue : AstQueue ); 45 | (* Releases queue and passes back NIL if successful. *) 46 | 47 | 48 | END AstQueue. 49 | -------------------------------------------------------------------------------- /src/BuildParams.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE BuildParams; 4 | 5 | (* Build Parameters for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | 8 | (* In-File Parameters *) 9 | 10 | CONST 11 | MaxInFileSize = 65536; 12 | MaxInFileLines = 12000; 13 | MaxInFileColumns = 160; 14 | 15 | TYPE 16 | LineCounter = CARDINAL [0 .. MaxInFileLines-1]; 17 | ColumnCounter = CARDINAL [0 .. MaxInFileColums-1]; 18 | 19 | 20 | (* Lexical Parameters *) 21 | 22 | CONST 23 | MaxIdentLength = 32; 24 | MaxNumberLength = 32; 25 | MaxStringLength = 160; 26 | MaxCommentLength = 4096; 27 | 28 | 29 | END BuildParams. 30 | -------------------------------------------------------------------------------- /src/DepGraph.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2016 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE DepGraph; 4 | 5 | (* Dependency Graph for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM Source IMPORT SourceT; 8 | FROM String IMPORT StringT; 9 | 10 | 11 | (* Dependency Graph Type *) 12 | 13 | TYPE DepGraph; (* OPAQUE *) 14 | 15 | TYPE DepGraphT = DepGraph; (* for unqualified use *) 16 | 17 | 18 | (* Iterator Procedure Type *) 19 | 20 | TYPE IteratorBody = PROCEDURE ( StringT ); 21 | 22 | 23 | (* Operations *) 24 | 25 | PROCEDURE New ( VAR graph : DepGraph; forSource : SourceT ); 26 | (* Allocates a new branch node of the given node type, stores the subnodes of 27 | the argument list in the node and passes back node, or NIL on failure. *) 28 | 29 | PROCEDURE count ( graph : DepGraph ) : CARDINAL; 30 | (* Returns the number of entries in graph. *) 31 | 32 | PROCEDURE isDependent 33 | ( graph : DepGraph; module1, module2 : StringT ) : BOOLEAN; 34 | (* Returns TRUE if module1 depends on module2, otherwise FALSE. *) 35 | 36 | PROCEDURE isMutuallyDependent 37 | ( graph : DepGraph; module1, module2 : StringT ) : BOOLEAN; 38 | (* Returns TRUE if module1 and module2 are mutually dependent, else FALSE. *) 39 | 40 | PROCEDURE Iterate ( graph : DepGraph; p : IteratorBody ); 41 | (* Calls p for every module in graph, passing the module identifier to p. *) 42 | 43 | PROCEDURE Release ( VAR graph : DepGraph ); 44 | (* Releases graph and passes back NIL if successful. *) 45 | 46 | 47 | END DepGraph. 48 | -------------------------------------------------------------------------------- /src/LexQueue.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE LexQueue; 4 | 5 | (* Lexeme Queue for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM String IMPORT StringT; 8 | 9 | 10 | TYPE LexQueue; (* OPAQUE *) 11 | 12 | TYPE LexQueueT = LexQueue; (* for unqualified use *) 13 | 14 | 15 | (* Operations *) 16 | 17 | PROCEDURE New ( VAR queue : LexQueue ); 18 | (* Allocates a new empty queue object and passes it back in queue. 19 | Passes NIL if the allocation failed. *) 20 | 21 | PROCEDURE enqueue ( queue : LexQueue; lexeme : StringT ) : LexQueue; 22 | (* Adds lexeme to the head of queue and returns queue, or NIL on failure. *) 23 | 24 | PROCEDURE enqueueUnique ( queue : LexQueue; lexeme : StringT ) : LexQueue; 25 | (* Adds lexeme to the head of queue if and only if the value is not already 26 | * present in queue. Returns queue on success, or NIL on failure. *) 27 | 28 | PROCEDURE dequeue ( queue : LexQueue ) : StringT; 29 | (* Removes the lexeme at the tail queue and returns it, or NIL on failure. *) 30 | 31 | PROCEDURE isEmpty ( queue : LexQueue ) : BOOLEAN; 32 | (* Returns TRUE if queue is empty, otherwise FALSE. *) 33 | 34 | PROCEDURE isElem ( queue : LexQueue; lexeme : StringT ) : BOOLEAN; 35 | (* Returns TRUE if node is stored in queue, otherwise FALSE. *) 36 | 37 | PROCEDURE count ( queue : LexQueue ) : CARDINAL; 38 | (* Returns the number of nodes in queue. *) 39 | 40 | PROCEDURE Reset ( queue : LexQueue ) : LexQueue; 41 | (* Removes all nodes from queue but does not deallocate it. 42 | Returns queue on success, or NIL if queue is NIL. *) 43 | 44 | PROCEDURE Release ( VAR queue : LexQueue ); 45 | (* Releases queue and passes back NIL if successful. *) 46 | 47 | 48 | END LexQueue. 49 | -------------------------------------------------------------------------------- /src/Lexer.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Lexer; 4 | 5 | (* Lexer for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM Symbol IMPORT SymbolT; 8 | FROM String IMPORT StringT; 9 | 10 | 11 | (* Lexer Type *) 12 | 13 | TYPE Lexer = OPAQUE; 14 | 15 | TYPE LexerT = Lexer; (* for unqualified use *) 16 | 17 | 18 | (* Lexer Status *) 19 | 20 | TYPE Status = 21 | ( Success, 22 | AlreadyInitialised, 23 | UnableToAllocate, 24 | IllegalSymbolFound, 25 | UnescapedBackslash, 26 | IllegalCharInCharOrString, 27 | EndOfLineInCharOrString, 28 | LexemeCapacityExceded, 29 | CommentNestingLimitExceded, 30 | PrematureEndOfFile ); 31 | 32 | 33 | (* Operations *) 34 | 35 | PROCEDURE New ( VAR lexer : Lexer; filename : StringT; VAR s : Status ); 36 | (* Create newly allocated and initialised lexer instance associated with 37 | source file filename. Passes back the status of the operation in s. *) 38 | 39 | PROCEDURE GetSym ( lexer : Lexer; VAR current, next : SymbolT ); 40 | (* Passes back the current lookahead symbol in current and consumes it. 41 | Passes back the new lookahead symbol in next without consuming it. *) 42 | 43 | PROCEDURE consumeSym ( lexer : Lexer ) : SymbolT; 44 | (* Returns the current lookahead symbol and consumes it. *) 45 | 46 | PROCEDURE lookaheadSym ( lexer : Lexer ) : SymbolT; 47 | (* Returns the current lookahead symbol without consuming it. *) 48 | 49 | PROCEDURE warnCount ( lexer : Lexer ) : CARDINAL; 50 | (* Returns the lexer's accumulated warning count. *) 51 | 52 | PROCEDURE errorCount ( lexer : Lexer ) : CARDINAL; 53 | (* Returns the lexer's accumulated error count. *) 54 | 55 | PROCEDURE status ( lexer : Lexer ) : Status; 56 | (* Returns the status of the last operation. *) 57 | 58 | PROCEDURE Release ( VAR lexer : Lexer ); 59 | (* Release lexer instance. Passes back NIL in lexer if successful. *) 60 | 61 | END Lexer. 62 | -------------------------------------------------------------------------------- /src/MatchLex.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE MatchLex; 4 | 5 | (* Lexer Support Library for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM Source IMPORT SourceT; 8 | FROM Diagnostic IMPORT DiagnosticT; 9 | 10 | 11 | (* Semantic Symbols *) 12 | 13 | PROCEDURE Ident ( source : SourceT; VAR diag : DiagnosticT ); 14 | (* Matches the input in source to an identifier and consumes it. *) 15 | 16 | 17 | PROCEDURE IdentOrResword ( source : SourceT; VAR diag : DiagnosticT ); 18 | (* Matches the input in source to an identifier or reserved word 19 | and consumes it. *) 20 | 21 | 22 | PROCEDURE NumericLiteral ( source : SourceT; VAR diag : DiagnosticT ); 23 | (* Matches the input in source to a numeric literal and consumes it. *) 24 | 25 | 26 | PROCEDURE QuotedLiteral ( source : SourceT; VAR diag : DiagnosticT ); 27 | (* Matches the input in source to a quoted literal and consumes it. *) 28 | 29 | 30 | (* Non-Semantic Symbols *) 31 | 32 | PROCEDURE LineComment ( source : SourceT; VAR diag : DiagnosticT ); 33 | (* Matches the input in source to an opening line comment delimiter and 34 | consumes the line, including its closing NEWLINE control character. *) 35 | 36 | 37 | PROCEDURE BlockComment ( source : SourceT; VAR diag : DiagnosticT ); 38 | (* Matches the input in source to an opening block comment delimiter 39 | and consumes the comment, including its closing delimiter. *) 40 | 41 | 42 | PROCEDURE Pragma ( source : SourceT; VAR diag : DiagnosticT ); 43 | (* Matches the input in source to an opening pragma delimiter 44 | and consumes the pragma, including its closing delimiter. *) 45 | 46 | 47 | (* Disabled Code Sections *) 48 | 49 | PROCEDURE DisabledCodeBlock ( source : SourceT; VAR diag : DiagnosticT ); 50 | (* Matches the input in source to an opening disabled code block delimiter 51 | and consumes the disabled code block, including its closing delimiter. *) 52 | 53 | 54 | END MatchLex. 55 | -------------------------------------------------------------------------------- /src/ModuleKey.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2016 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE ModuleKey; 4 | 5 | (* Module Key Generator for Modula-2 Bootstrap Kernel *) 6 | 7 | 8 | CONST 9 | BitsPerKey = 128; 10 | KeySize = BitsPerKey DIV 8; 11 | 12 | 13 | (* Key Type *) 14 | 15 | TYPE Key = ARRAY [0..KeySize] OF CHAR; 16 | 17 | 18 | (* Key Generator *) 19 | 20 | PROCEDURE GenKey ( VAR key : Key; forBuffer : ARRAY OF CHAR ); 21 | 22 | 23 | END ModuleKey. 24 | -------------------------------------------------------------------------------- /src/NonTerminals.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE NonTerminals; 4 | 5 | (* FIRST/FOLLOW set database for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM Token IMPORT TokenT; 8 | FROM TokenSet IMPORT TokenSetT; 9 | 10 | 11 | (* Productions *) 12 | 13 | TYPE Production = 14 | ( CompilationUnit, 15 | DefintionModule, 16 | Import, 17 | Definition, 18 | ConstDefinition, 19 | SimpleConstDefinition, 20 | TypeDefinition, 21 | AliasType, 22 | Qualident, 23 | SubrangeType, 24 | Range, 25 | EnumType, 26 | IdentList, 27 | SetType, 28 | ArrayType, 29 | RecordType, 30 | FieldList, 31 | RecTypeToExtend, 32 | PointerType, 33 | ProcedureType, 34 | FormalType, 35 | NonAttrFormalType, 36 | SimpleFormalType, 37 | CastingFormalType, 38 | VariadicFormalType, 39 | ProcedureHeader, 40 | BindingSpecifier, 41 | BindableIdent, 42 | ProcedureSignature, 43 | FormalParams, 44 | ProgramModule, 45 | PrivateImport, 46 | Block, 47 | ImplementationModule, 48 | PossiblyEmptyBlock, 49 | Declaration, 50 | TypeDeclaration, 51 | PointerOrIndeterminateType, 52 | IndeterminateTarget, 53 | IndeterminateField, 54 | VarDeclaration, 55 | AliasDeclaration, 56 | NameSelector, 57 | StatementSequence, 58 | Statement, 59 | MemMgtOperation, 60 | NewStatement, 61 | RetainStatement, 62 | ReleaseStatement, 63 | UpdateOrProcCall, 64 | ReturnStatement, 65 | CopyStatement, 66 | ReadStatement, 67 | WriteStatement, 68 | InputArg, 69 | OutputArgs, 70 | FormattedArgs, 71 | IfStatement, 72 | CaseStatement, 73 | Case, 74 | CaseLabels, 75 | LoopStatement, 76 | WhileStatement, 77 | RepeatStatement, 78 | ForStatement, 79 | ForLoopVariants, 80 | IterableExpr, 81 | OrdinalRange, 82 | Designator, 83 | DesignatorTail, 84 | SubscriptOrSlice, 85 | TargetDesignator, 86 | TargetDesignatorTail, 87 | SubscriptOrSliceOrInsert, 88 | FieldSelector, 89 | ExpressionList, 90 | Expression, 91 | SimpleExpression, 92 | Term, 93 | SimpleTerm, 94 | Factor, 95 | SimpleFactor, 96 | DesignatorOrFuncCall, 97 | StructuredValue, 98 | ValueComponent, 99 | ToDoList, 100 | TrackingRef, 101 | TaskToDo 102 | ); 103 | 104 | TYPE ProductionT = Production; (* for unqualified use *) 105 | 106 | 107 | (* Operations *) 108 | 109 | PROCEDURE FIRST ( p : Production ) : TokenSetT; 110 | (* Returns a reference to the FIRST set of production p. *) 111 | 112 | PROCEDURE inFIRST ( p : Production; token : TokenT ) : BOOLEAN; 113 | (* Returns TRUE if token is an element of FIRST(p), otherwise FALSE. *) 114 | 115 | PROCEDURE FOLLOW ( p : Production ) : TokenSetT; 116 | (* Returns a reference to the FOLLOW set of production p. *) 117 | 118 | PROCEDURE inFOLLOW ( p : Production; token : TokenT ) : BOOLEAN; 119 | (* Returns TRUE if token is an element of FOLLOW(p), otherwise FALSE. *) 120 | 121 | 122 | END NonTerminals. 123 | -------------------------------------------------------------------------------- /src/Parser.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Parser; 4 | 5 | (* Parser for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | 8 | FROM AST IMPORT AstT; 9 | FROM String IMPORT StringT; 10 | 11 | 12 | (* Return Status *) 13 | 14 | TYPE Status = ( Success, Failure ); 15 | 16 | 17 | (* Result Summary *) 18 | 19 | TYPE Statistics = RECORD 20 | lexicalWarnings, 21 | lexicalErrors, 22 | syntaxWarnings, 23 | syntaxErrors : CARDINAL; 24 | END; 25 | 26 | 27 | (* Operations *) 28 | 29 | (* -------------------------------------------------------------------------- 30 | * public function compilationUnit(source, stats, status) 31 | * -------------------------------------------------------------------------- 32 | * Parses rule compilationUnit depending on the source file type and builds 33 | * its AST. Parses definitionModule for file type Def and implOrPrgmModule 34 | * for file type Mod. Returns the AST on success or NIL on failure. 35 | * 36 | * compilationUnit := 37 | * definitionModule | implOrPrgmModule 38 | * ; 39 | * -------------------------------------------------------------------------- 40 | *) 41 | PROCEDURE compilationUnit 42 | ( source : StringT; VAR stats : Statistics; VAR status : Status ) : AstT; 43 | 44 | 45 | END Parser. 46 | -------------------------------------------------------------------------------- /src/Primitive.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE Primitive; 4 | 5 | FROM String IMPORT StringT; 6 | 7 | 8 | VAR (* use read-only *) 9 | alloc, atinsert, atremove, atstore, atvalue, dealloc, kvalue, kvstore, 10 | stdin, stdout : StringT; 11 | 12 | 13 | PROCEDURE isPrimitive ( lexeme : StringT ) : BOOLEAN; 14 | (* Returns TRUE if lexeme represents a primitive identifier, else FALSE. *) 15 | 16 | 17 | END Primitive. 18 | -------------------------------------------------------------------------------- /src/Resword.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | IMPLEMENTATION MODULE Resword; 4 | 5 | FROM Token IMPORT TokenT; 6 | FROM String IMPORT StringT; 7 | 8 | 9 | VAR (* use read-only *) 10 | alias, and, arglist, array, begin, case, const, copy, definition, div, do, 11 | else, elsif, end, exit, for, if, implementation, import, in, loop, mod, 12 | module, new, nop, not, octetseq, of, opaque, or, pointer, procedure, read, 13 | record, release, repeat, retain, return, set, then, to, type, unqualified, 14 | until, var, while, write : StringT; 15 | 16 | 17 | PROCEDURE tokenForLexeme ( lexeme : StringT; defaultToken : TokenT ) : TokenT; 18 | (* If lexeme represents a reserved word, its corresponding reserved word's 19 | token is returned, otherwise the value of defaultToken is returned. *) 20 | 21 | 22 | PROCEDURE lexemeForToken ( token : TokenT ) : StringT; 23 | (* If token represents a reserved word, an interned string with its 24 | corresponding lexeme is returned, otherwise NIL is returned. *) 25 | 26 | END Resword. 27 | -------------------------------------------------------------------------------- /src/Symbol.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Symbol; 4 | 5 | (* Symbol Definition for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM Token IMPORT TokenT; 8 | FROM String IMPORT StringT; 9 | FROM Diagnostic IMPORT DiagnosticT; 10 | 11 | 12 | (* Symbol to be returned by lexer *) 13 | 14 | TYPE Symbol = RECORD 15 | token : TokenT; 16 | line, col : CARDINAL; 17 | lexeme : StringT; 18 | diagnostic : DiagnosticT 19 | END; (* Symbol *) 20 | 21 | TYPE SymbolT = Symbol; (* for unqualified use *) 22 | 23 | END Symbol. 24 | -------------------------------------------------------------------------------- /src/Token.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Token; 4 | 5 | (* Token Definitions for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | 8 | (* All Tokens *) 9 | 10 | TYPE Token = 11 | ( Invalid, (* 0 *) 12 | 13 | (* Reserved Words *) 14 | Alias, (* 1 *) 15 | And, (* 2 *) (* operator *) 16 | Arglist, (* 3 *) 17 | Array, (* 4 *) 18 | Begin, (* 5 *) 19 | Case, (* 6 *) 20 | Const, (* 7 *) 21 | Copy, (* 8 *) 22 | Definition, (* 9 *) 23 | Div, (* 10 *) (* operator *) 24 | Do, (* 11 *) 25 | Else, (* 12 *) 26 | Elsif, (* 13 *) 27 | End, (* 14 *) 28 | Exit, (* 15 *) 29 | For, (* 16 *) 30 | If, (* 17 *) 31 | Implementation, (* 18 *) 32 | Import, (* 19 *) 33 | In, (* 20 *) (* operator *) 34 | Loop, (* 21 *) 35 | Mod, (* 22 *) (* operator *) 36 | Module, (* 23 *) 37 | New, (* 24 *) 38 | Nop, (* 25 *) 39 | Not, (* 26 *) (* operator *) 40 | Octetseq, (* 27 *) 41 | Of, (* 28 *) 42 | Opaque, (* 29 *) 43 | Or, (* 30 *) (* operator *) 44 | Pointer, (* 31 *) 45 | Procedure, (* 32 *) 46 | Read, (* 33 *) 47 | Record, (* 34 *) 48 | Release, (* 35 *) 49 | Repeat, (* 36 *) 50 | Retain, (* 37 *) 51 | Return, (* 38 *) 52 | Set, (* 39 *) 53 | Then, (* 40 *) 54 | To, (* 41 *) 55 | Type, (* 42 *) 56 | Unqualified, (* 43 *) 57 | Until, (* 44 *) 58 | Var, (* 45 *) 59 | While, (* 46 *) 60 | Write, (* 47 *) 61 | 62 | (* Identifiers *) 63 | StdIdent, (* 48 *) 64 | Primitive, (* 49 *) 65 | 66 | (* Literals *) 67 | RealNumber, (* 50 *) 68 | WholeNumber, (* 51 *) 69 | CharCode, (* 52 *) 70 | QuotedString, (* 53 *) 71 | 72 | (* Punctuation *) 73 | Comma, (* 54 *) 74 | Colon, (* 55 *) 75 | Semicolon, (* 56 *) 76 | AtSign, (* 57 *) 77 | VerticalBar, (* 58 *) 78 | DotDot, (* 59 *) 79 | Assign, (* 60 *) 80 | PlusPlus, (* 61 *) 81 | MinusMinus, (* 62 *) 82 | DotStar, (* 63 *) 83 | 84 | (* Paired Delimiters *) 85 | LParen, (* 64 *) 86 | RParen, (* 65 *) 87 | LBracket, (* 66 *) 88 | RBracket, (* 67 *) 89 | LBrace, (* 68 *) 90 | RBrace, (* 69 *) 91 | 92 | (* Operators *) 93 | 94 | (* Non-Resword Level-1 Operators *) 95 | Equal, (* 70 *) (* also used as punctuation *) 96 | NotEqual, (* 71 *) 97 | Less, (* 72 *) 98 | LessOrEq, (* 73 *) 99 | Greater, (* 74 *) 100 | GreaterOrEq, (* 75 *) 101 | Identity, (* 76 *) 102 | 103 | (* Non-Resword Level-2 Operators *) 104 | Plus, (* 77 *) (* also used as punctuation *) 105 | Minus, (* 78 *) 106 | Concat, (* 79 *) 107 | SetDiff, (* 80 *) 108 | 109 | (* Non-Resword Level-3 Operators *) 110 | Asterisk, (* 81 *) (* also used as punctuation *) 111 | RealDiv, (* 82 *) 112 | 113 | (* Non-Resword Level-4 Operators *) 114 | (* none *) 115 | 116 | (* Non-Resword Level-5 Operators *) 117 | TypeConv, (* 83 *) 118 | 119 | (* Non-Resword Level-6 Operators *) 120 | Dot, (* 84 *) (* also used as punctuation *) 121 | Deref, (* 85 *) 122 | 123 | (* End Of File Marker *) 124 | EOF, (* 86 *) 125 | 126 | (* Comments and Pragmas *) 127 | LineComment, (* 87 *) 128 | BlockComment, (* 88 *) 129 | Pragma ); (* 89 *) 130 | 131 | 132 | TYPE TokenT = Token; (* for unqualified use *) 133 | 134 | 135 | (* Semantic Tokens *) 136 | 137 | TYPE Semantic = Token [Invalid..EOF]; 138 | 139 | 140 | (* Functions To Determine Token Classification *) 141 | 142 | PROCEDURE isResword ( t : Token ) : BOOLEAN; 143 | (* Returns TRUE if t is a reserved word, otherwise FALSE. *) 144 | 145 | PROCEDURE isIdentifier ( t : Token ) : BOOLEAN; 146 | (* Returns TRUE if t is an identifier, otherwise FALSE. *) 147 | 148 | PROCEDURE isNumber ( t : Token ) : BOOLEAN; 149 | (* Returns TRUE if t is a number literal, otherwise FALSE. *) 150 | 151 | PROCEDURE isCharOrString ( t : Token ) : BOOLEAN; 152 | (* Returns TRUE if t is a character or string, otherwise FALSE. *) 153 | 154 | PROCEDURE isConstExprLiteral ( t : TokenT ) : BOOLEAN; 155 | (* Returns TRUE if t is a constant expression literal, otherwise FALSE. *) 156 | 157 | PROCEDURE isOperL1 ( t : Token ) : BOOLEAN; 158 | (* Returns TRUE if t is a level-1 operator, otherwise FALSE. *) 159 | 160 | PROCEDURE isOperL2 ( t : Token ) : BOOLEAN; 161 | (* Returns TRUE if t is a level-2 operator, otherwise FALSE. *) 162 | 163 | PROCEDURE isOperL3 ( t : Token ) : BOOLEAN; 164 | (* Returns TRUE if t is a level-3 operator, otherwise FALSE. *) 165 | 166 | PROCEDURE isComment ( t : Token ) : BOOLEAN; 167 | (* Returns TRUE if t is a comment, otherwise FALSE. *) 168 | 169 | PROCEDURE isPragma ( t : Token ) : BOOLEAN; 170 | (* Returns TRUE if t is a pragma, otherwise FALSE. *) 171 | 172 | END Token. 173 | -------------------------------------------------------------------------------- /src/TokenSet.16bit.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE TokenSet; (* 16-bit version *) 4 | 5 | (* Token Set ADT for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM Token IMPORT TokenT; 8 | 9 | 10 | (* -------------------------------------------------------------------------- 11 | * TokenSet type 12 | * ----------------------------------------------------------------------- *) 13 | 14 | TYPE TokenSet; (* OPAQUE *) 15 | 16 | TYPE TokenSetT = TokenSet; (* for unqualified use *) 17 | 18 | 19 | (* Operations *) 20 | 21 | (* -------------------------------------------------------------------------- 22 | * procedure NewFromRawData(set, seg5, seg4, seg3, seg2, seg1, seg0) 23 | * -------------------------------------------------------------------------- 24 | * Passes a newly allocated and initialised TokenSet instance back in set. 25 | * The set is initalised from parameters segment5 to segment0 as follows: 26 | * 27 | * bit 95 bit 0 28 | * v v 29 | * [<---------------------------set-------------------------->] 30 | * [segment5][segment4][segment3][segment2][segment1][segment0] 31 | * ^ ^ ^ ^ ^ ^ 32 | * bit 15 bit 15 bit 15 bit 15 bit 15 bit 15 33 | * 34 | * The bits in set correspond to the token values of type Token. 35 | * ----------------------------------------------------------------------- *) 36 | 37 | PROCEDURE NewFromRawData 38 | ( VAR set : TokenSet; 39 | segment5, segment4, segment3, segment2, segment1, segment0 : CARDINAL ); 40 | 41 | 42 | (* -------------------------------------------------------------------------- 43 | * procedure NewFromArray(set, tokenList) 44 | * -------------------------------------------------------------------------- 45 | * Passes a newly allocated and initialised TokenSet instance back in set. 46 | * The set is initialised with the tokens passed in the tokenList array. 47 | * Passes back NIL if allocation is unsuccessful. 48 | * ----------------------------------------------------------------------- *) 49 | 50 | PROCEDURE NewFromArray 51 | ( VAR set : TokenSet; tokenList : ARRAY OF Token ); 52 | 53 | 54 | (* -------------------------------------------------------------------------- 55 | * procedure Insert(set, token) 56 | * -------------------------------------------------------------------------- 57 | * Inserts token into set. 58 | * ----------------------------------------------------------------------- *) 59 | 60 | PROCEDURE Insert ( set : TokenSet; token : TokenT ); 61 | 62 | 63 | (* -------------------------------------------------------------------------- 64 | * procedure Remove(set, token) 65 | * -------------------------------------------------------------------------- 66 | * Removes token from set. 67 | * ----------------------------------------------------------------------- *) 68 | 69 | PROCEDURE Remove ( set : TokenSet; token : TokenT ); 70 | 71 | 72 | (* -------------------------------------------------------------------------- 73 | * function isEmpty(set) 74 | * -------------------------------------------------------------------------- 75 | * Returns TRUE if set is empty, otherwise FALSE. 76 | * ----------------------------------------------------------------------- *) 77 | 78 | PROCEDURE isEmpty ( set : TokenSet ) : BOOLEAN; 79 | 80 | 81 | (* -------------------------------------------------------------------------- 82 | * function isElem(set) 83 | * -------------------------------------------------------------------------- 84 | * Returns TRUE if token is an element of set, otherwise FALSE. 85 | * ----------------------------------------------------------------------- *) 86 | 87 | PROCEDURE isElem ( set : TokenSet; token : TokenT ) : BOOLEAN; 88 | 89 | 90 | (* -------------------------------------------------------------------------- 91 | * function count(set) 92 | * -------------------------------------------------------------------------- 93 | * Returns the number of tokens in set. 94 | * ----------------------------------------------------------------------- *) 95 | 96 | PROCEDURE count ( set : TokenSet ) : CARDINAL; 97 | 98 | 99 | (* -------------------------------------------------------------------------- 100 | * procedure PrintTokenList(set) 101 | * -------------------------------------------------------------------------- 102 | * Prints a comma separated list of tokens in set. 103 | * ----------------------------------------------------------------------- *) 104 | 105 | PROCEDURE PrintTokenList ( set : TokenSet ); 106 | 107 | 108 | (* -------------------------------------------------------------------------- 109 | * procedure PrintSegments(set) 110 | * -------------------------------------------------------------------------- 111 | * Prints a comma separated list of the data segments of set in base-16. 112 | * ----------------------------------------------------------------------- *) 113 | 114 | PROCEDURE PrintSegments ( set : TokenSet ); 115 | 116 | 117 | (* -------------------------------------------------------------------------- 118 | * procedure Release(set) 119 | * -------------------------------------------------------------------------- 120 | * Releases set and passes back NIL. 121 | * ----------------------------------------------------------------------- *) 122 | 123 | PROCEDURE Release ( VAR set : TokenSet ); 124 | 125 | 126 | END TokenSet. -------------------------------------------------------------------------------- /src/TokenSet.32bit.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE TokenSet; (* 32-bit version *) 4 | 5 | (* Token Set ADT for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM Token IMPORT TokenT; 8 | 9 | 10 | (* -------------------------------------------------------------------------- 11 | * TokenSet type 12 | * ----------------------------------------------------------------------- *) 13 | 14 | TYPE TokenSet; (* OPAQUE *) 15 | 16 | TYPE TokenSetT = TokenSet; (* for unqualified use *) 17 | 18 | 19 | (* Operations *) 20 | 21 | (* -------------------------------------------------------------------------- 22 | * procedure NewFromRawData(set, segment2, segment1, segment0) 23 | * -------------------------------------------------------------------------- 24 | * Passes a newly allocated and initialised TokenSet instance back in set. 25 | * The set is initalised from parameters segment2 to segment0 as follows: 26 | * 27 | * bit 127 bit 0 28 | * v v 29 | * [<------------set----------->] 30 | * [segment2][segment1][segment0] 31 | * ^ ^ ^ 32 | * bit 31 bit 31 bit 31 33 | * 34 | * The bits in set correspond to the token values of type Token. 35 | * ----------------------------------------------------------------------- *) 36 | 37 | PROCEDURE NewFromRawData 38 | ( VAR set : TokenSet; segment2, segment1, segment0 : CARDINAL ); 39 | 40 | 41 | (* -------------------------------------------------------------------------- 42 | * procedure NewFromArray(set, tokenList) 43 | * -------------------------------------------------------------------------- 44 | * Passes a newly allocated and initialised TokenSet instance back in set. 45 | * The set is initialised with the tokens passed in the tokenList array. 46 | * Passes back NIL if allocation is unsuccessful. 47 | * ----------------------------------------------------------------------- *) 48 | 49 | PROCEDURE NewFromArray 50 | ( VAR set : TokenSet; tokenList : ARRAY OF Token ); 51 | 52 | 53 | (* -------------------------------------------------------------------------- 54 | * procedure Insert(set, token) 55 | * -------------------------------------------------------------------------- 56 | * Inserts token into set. 57 | * ----------------------------------------------------------------------- *) 58 | 59 | PROCEDURE Insert ( set : TokenSet; token : TokenT ); 60 | 61 | 62 | (* -------------------------------------------------------------------------- 63 | * procedure Remove(set, token) 64 | * -------------------------------------------------------------------------- 65 | * Removes token from set. 66 | * ----------------------------------------------------------------------- *) 67 | 68 | PROCEDURE Remove ( set : TokenSet; token : TokenT ); 69 | 70 | 71 | (* -------------------------------------------------------------------------- 72 | * function isEmpty(set) 73 | * -------------------------------------------------------------------------- 74 | * Returns TRUE if set is empty, otherwise FALSE. 75 | * ----------------------------------------------------------------------- *) 76 | 77 | PROCEDURE isEmpty ( set : TokenSet ) : BOOLEAN; 78 | 79 | 80 | (* -------------------------------------------------------------------------- 81 | * function isElem(set) 82 | * -------------------------------------------------------------------------- 83 | * Returns TRUE if token is an element of set, otherwise FALSE. 84 | * ----------------------------------------------------------------------- *) 85 | 86 | PROCEDURE isElem ( set : TokenSet; token : TokenT ) : BOOLEAN; 87 | 88 | 89 | (* -------------------------------------------------------------------------- 90 | * function count(set) 91 | * -------------------------------------------------------------------------- 92 | * Returns the number of tokens in set. 93 | * ----------------------------------------------------------------------- *) 94 | 95 | PROCEDURE count ( set : TokenSet ) : CARDINAL; 96 | 97 | 98 | (* -------------------------------------------------------------------------- 99 | * procedure PrintTokenList(set) 100 | * -------------------------------------------------------------------------- 101 | * Prints a comma separated list of tokens in set. 102 | * ----------------------------------------------------------------------- *) 103 | 104 | PROCEDURE PrintTokenList ( set : TokenSet ); 105 | 106 | 107 | (* -------------------------------------------------------------------------- 108 | * procedure PrintSegments(set) 109 | * -------------------------------------------------------------------------- 110 | * Prints a comma separated list of the data segments of set in base-16. 111 | * ----------------------------------------------------------------------- *) 112 | 113 | PROCEDURE PrintSegments ( set : TokenSet ); 114 | 115 | 116 | (* -------------------------------------------------------------------------- 117 | * procedure Release(set) 118 | * -------------------------------------------------------------------------- 119 | * Releases set and passes back NIL. 120 | * ----------------------------------------------------------------------- *) 121 | 122 | PROCEDURE Release ( VAR set : TokenSet ); 123 | 124 | 125 | END TokenSet. -------------------------------------------------------------------------------- /src/TokenSet.64bit.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE TokenSet; (* 64-bit version *) 4 | 5 | (* Token Set ADT for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM Token IMPORT TokenT; 8 | 9 | 10 | (* -------------------------------------------------------------------------- 11 | * TokenSet type 12 | * ----------------------------------------------------------------------- *) 13 | 14 | TYPE TokenSet; (* OPAQUE *) 15 | 16 | TYPE TokenSetT = TokenSet; (* for unqualified use *) 17 | 18 | 19 | (* Operations *) 20 | 21 | (* -------------------------------------------------------------------------- 22 | * procedure NewFromRawData(set, segment1, segment0) 23 | * -------------------------------------------------------------------------- 24 | * Passes a newly allocated and initialised TokenSet instance back in set. 25 | * The set is initalised from parameters segment1 and segment0 as follows: 26 | * 27 | * bit 127 bit 0 28 | * v v 29 | * [<-------set------>] 30 | * [segment1][segment0] 31 | * ^ ^ 32 | * bit 63 bit 63 33 | * 34 | * The bits in set correspond to the token values of type Token. 35 | * ----------------------------------------------------------------------- *) 36 | 37 | PROCEDURE NewFromRawData 38 | ( VAR set : TokenSet; segment1, segment0 : CARDINAL ); 39 | 40 | 41 | (* -------------------------------------------------------------------------- 42 | * procedure NewFromArray(set, tokenList) 43 | * -------------------------------------------------------------------------- 44 | * Passes a newly allocated and initialised TokenSet instance back in set. 45 | * The set is initialised with the tokens passed in the tokenList array. 46 | * Passes back NIL if allocation is unsuccessful. 47 | * ----------------------------------------------------------------------- *) 48 | 49 | PROCEDURE NewFromArray 50 | ( VAR set : TokenSet; tokenList : ARRAY OF Token ); 51 | 52 | 53 | (* -------------------------------------------------------------------------- 54 | * procedure Insert(set, token) 55 | * -------------------------------------------------------------------------- 56 | * Inserts token into set. 57 | * ----------------------------------------------------------------------- *) 58 | 59 | PROCEDURE Insert ( set : TokenSet; token : TokenT ); 60 | 61 | 62 | (* -------------------------------------------------------------------------- 63 | * procedure Remove(set, token) 64 | * -------------------------------------------------------------------------- 65 | * Removes token from set. 66 | * ----------------------------------------------------------------------- *) 67 | 68 | PROCEDURE Remove ( set : TokenSet; token : TokenT ); 69 | 70 | 71 | (* -------------------------------------------------------------------------- 72 | * function isEmpty(set) 73 | * -------------------------------------------------------------------------- 74 | * Returns TRUE if set is empty, otherwise FALSE. 75 | * ----------------------------------------------------------------------- *) 76 | 77 | PROCEDURE isEmpty ( set : TokenSet ) : BOOLEAN; 78 | 79 | 80 | (* -------------------------------------------------------------------------- 81 | * function isElem(set) 82 | * -------------------------------------------------------------------------- 83 | * Returns TRUE if token is an element of set, otherwise FALSE. 84 | * ----------------------------------------------------------------------- *) 85 | 86 | PROCEDURE isElem ( set : TokenSet; token : TokenT ) : BOOLEAN; 87 | 88 | 89 | (* -------------------------------------------------------------------------- 90 | * function count(set) 91 | * -------------------------------------------------------------------------- 92 | * Returns the number of tokens in set. 93 | * ----------------------------------------------------------------------- *) 94 | 95 | PROCEDURE count ( set : TokenSet ) : CARDINAL; 96 | 97 | 98 | (* -------------------------------------------------------------------------- 99 | * procedure PrintTokenList(set) 100 | * -------------------------------------------------------------------------- 101 | * Prints a comma separated list of tokens in set. 102 | * ----------------------------------------------------------------------- *) 103 | 104 | PROCEDURE PrintTokenList ( set : TokenSet ); 105 | 106 | 107 | (* -------------------------------------------------------------------------- 108 | * procedure PrintSegments(set) 109 | * -------------------------------------------------------------------------- 110 | * Prints a comma separated list of the data segments of set in base-16. 111 | * ----------------------------------------------------------------------- *) 112 | 113 | PROCEDURE PrintSegments ( set : TokenSet ); 114 | 115 | 116 | (* -------------------------------------------------------------------------- 117 | * procedure Release(set) 118 | * -------------------------------------------------------------------------- 119 | * Releases set and passes back NIL. 120 | * ----------------------------------------------------------------------- *) 121 | 122 | PROCEDURE Release ( VAR set : TokenSet ); 123 | 124 | 125 | END TokenSet. -------------------------------------------------------------------------------- /src/imp/AstNodeType.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015, 2020 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE AstNodeType; 4 | 5 | (* AST Node Type Implementation for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | 8 | FROM String IMPORT StringT; 9 | 10 | 11 | (* Table for human readable names of node types *) 12 | 13 | VAR typeName : ARRAY [Invalid .. Qualident] OF StringT; 14 | 15 | 16 | (* Category Tests *) 17 | 18 | PROCEDURE isNonTerminal ( t : AstNodeType ) : BOOLEAN; 19 | (* Returns TRUE if t is a non-terminal node type, otherwise FALSE. *) 20 | 21 | BEGIN 22 | RETURN (t >= MIN(Arity0)) AND (t < MIN(Terminal1)) 23 | OR (t >= MIN(Arity2)) AND (t < MIN(TerminalN)) 24 | END isNonTerminal; 25 | 26 | 27 | PROCEDURE isTerminal ( t : AstNodeType ) : BOOLEAN; 28 | (* Returns TRUE if t is a terminal node type, otherwise FALSE. *) 29 | 30 | BEGIN 31 | RETURN (t >= MIN(Terminal1)) AND (t <= MAX(Terminal1)) 32 | OR (t >= MIN(TerminalN) AND (t <= MAX(TerminalN)) 33 | END isTerminal; 34 | 35 | 36 | (* Presentation *) 37 | 38 | PROCEDURE name ( t : AstNodeType ) : StringT; 39 | (* Returns a human readable name for node type t. *) 40 | 41 | BEGIN 42 | RETURN typeName[t] 43 | END name; 44 | 45 | 46 | BEGIN (* initialise name table *) 47 | typeName[Invalid] := String.forArray("???"); 48 | typeName[Empty] := String.forArray(""); 49 | typeName[Exit] := String.forArray("EXIT"); 50 | typeName[Nop] := String.forArray("NOP"); 51 | typeName[Alias] := String.forArray("ALIAS"); 52 | typeName[Set] := String.forArray("SET"); 53 | typeName[Pointer] := String.forArray("POINTER"); 54 | typeName[Unq] := String.forArray("UNQ"); 55 | typeName[Loop] := String.forArray("LOOP"); 56 | typeName[Neg] := String.forArray("NEG"); 57 | typeName[Not] := String.forArray("NOT"); 58 | typeName[Filename] := String.forArray("FILENAME"); 59 | typeName[Compiled] := String.forArray("COMPILED"); 60 | typeName[Digest] := String.forArray("DIGEST"); 61 | typeName[Ident] := String.forArray("ID"); 62 | typeName[Qualident] := String.forArray("QID"); 63 | typeName[IntVal] := String.forArray("INT"); 64 | typeName[RealVal] := String.forArray("REAL"); 65 | typeName[ChrVal] := String.forArray("CHR"); 66 | typeName[QuotedVal] := String.forArray("STR"); 67 | typeName[VarDecl] := String.forArray("VAR"); 68 | typeName[TypeDecl] := String.forArray("TYPE"); 69 | typeName[Array] := String.forArray("ARRAY"); 70 | typeName[Enum] := String.forArray("ENUM"); 71 | typeName[ProcType] := String.forArray("PROCTYPE"); 72 | typeName[Field] := String.forArray("FIELD"); 73 | typeName[Proc] := String.forArray("PROC"); 74 | typeName[Bind] := String.forArray("BIND"); 75 | typeName[PCall] := String.forArray("PCALL"); 76 | typeName[While] := String.forArray("WHILE"); 77 | typeName[Repeat] := String.forArray("REPEAT"); 78 | typeName[Range] := String.forArray("RANGE"); 79 | typeName[Eq] := String.forArray("EQ"); 80 | typeName[Neq] := String.forArray("NEQ"); 81 | typeName[Lt] := String.forArray("LT"); 82 | typeName[LtEq] := String.forArray("LTEQ"); 83 | typeName[Gt] := String.forArray("GT"); 84 | typeName[GtEq] := String.forArray("GTEQ"); 85 | typeName[In] := String.forArray("IN"); 86 | typeName[Plus] := String.forArray("PLUS"); 87 | typeName[Minus] := String.forArray("MINUS"); 88 | typeName[Or] := String.forArray("OR"); 89 | typeName[Star] := String.forArray("STAR"); 90 | typeName[Slash] := String.forArray("SLASH"); 91 | typeName[Div] := String.forArray("DIV"); 92 | typeName[Mod] := String.forArray("MOD"); 93 | typeName[And] := String.forArray("AND"); 94 | typeName[FCall] := String.forArray("FCALL"); 95 | typeName[Subr] := String.forArray("SUBR"); 96 | typeName[CompUnit] := String.forArray("COMPUNIT"); 97 | typeName[DefMod] := String.forArray("DEFMOD"); 98 | typeName[ImpMod] := String.forArray("IMPMOD"); 99 | typeName[Program] := String.forArray("PROG"); 100 | typeName[Import] := String.forArray("IMPORT"); 101 | typeName[Reexport] := String.forArray("REEXPORT"); 102 | typeName[StmtSeq] := String.forArray("STMT*"); 103 | typeName[ExprList] := String.forArray("EXPR*"); 104 | typeName[IdentList] := String.forArray("ID*"); 105 | typeName[QualidentList] := String.forArray("QID*") 106 | END AstNodeType. -------------------------------------------------------------------------------- /src/imp/M2BSK.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | MODULE M2BSK; 4 | 5 | (* Compiler Driver *) 6 | 7 | IMPORT 8 | Args, ArgParser, BuildInfo, BuildParams, 9 | FNStr, Infile, Outfile, Compiler; 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 = "M2BSK - Modula-2 Compiler"; 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; (* needs further adaptation *) 33 | 34 | BEGIN 35 | Console.WriteChars("Usage:\n"); 36 | Console.WriteChars("$ m2bsk infoRequest\n"); Console.WriteChars("or\n"); 37 | Console.WriteChars("$ m2bsk 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(" --tabwidth number : set tab width\n"); 48 | Console.WriteChars(" --newline mode : set newline mode\n\n"); 49 | 50 | Console.WriteChars("diagnostic:\n"); 51 | Console.WriteChars(" --verbose, -v : verbose output\n"); 52 | Console.WriteChars(" --show-settings : print all settings\n\n"); 53 | 54 | Console.WriteChars 55 | (" identifier | number | singleQuotedString | doubleQuotedString\n\n"); 56 | 57 | Console.WriteChars("mode:\n"); 58 | Console.WriteChars(" cr | lf | crlf\n\n") 59 | END PrintUsage; 60 | 61 | 62 | PROCEDURE PrintBuildInfo; 63 | 64 | BEGIN 65 | Console.WriteChars("Built on : "); 66 | Console.WriteChars(BuildInfo.Platform); 67 | Console.WriteChars("\nDialect : "); 68 | Console.WriteChars(BuildInfo.Dialect); 69 | Console.WriteChars("\nCompiler : "); 70 | Console.WriteChars(BuildInfo.Compiler); 71 | Console.WriteChars("\nI/O library : "); 72 | Console.WriteChars(BuildInfo.IOLibrary); 73 | Console.WriteChars("\nMemory Model: "); 74 | Console.WriteChars(BuildInfo.MemModel); 75 | Console.WriteLn 76 | END PrintBuildInfo; 77 | 78 | 79 | PROCEDURE PreflightCheck 80 | ( VAR infile : InfileT; VAR outfile : OutfileT; VAR passed : BOOLEAN ); 81 | 82 | VAR 83 | len : CARDINAL; 84 | pathStr : StringT; 85 | status : BasicFileIO.Status; 86 | path : ARRAY [0..BuildParams.MaxPathLen] OF CHAR; 87 | 88 | BEGIN 89 | pathStr := Settings.infile(); 90 | String.CopyToArray(pathStr, path, len); 91 | 92 | IF len = 0 THEN 93 | Console.WriteChars("source path too long.\n"); 94 | passed := FALSE; 95 | RETURN 96 | END; (* IF *) 97 | 98 | (* bail out if infile does not exist *) 99 | IF NOT fileExists(path) THEN 100 | Console.WriteChars("sourcefile not found.\n"); 101 | passed := FALSE; 102 | RETURN 103 | END; (* IF *) 104 | 105 | Infile.Open(infile, status); 106 | 107 | IF status # Success THEN 108 | Console.WriteChars("unable to open sourcefile.\n"); 109 | infile := Infile.Nil; 110 | passed := FALSE; 111 | RETURN 112 | END; (* IF *) 113 | 114 | IF NOT Settings.alreadySet(Settings.Outfile) THEN 115 | (* derive target name from source name *) 116 | pathStr := FNStr.targetName(pathStr) 117 | ELSE 118 | pathStr := Settings.outfile() 119 | END; (* IF *) 120 | 121 | String.CopyToArray(pathStr, path, len); 122 | 123 | IF len = 0 THEN 124 | Console.WriteChars("target path too long.\n"); 125 | passed := FALSE; 126 | RETURN 127 | END; (* IF *) 128 | 129 | IF fileExists(path) THEN 130 | (* rename existing file *) 131 | END; (* IF *) 132 | 133 | Outfile.Open(outfile, status); 134 | 135 | IF status # Success THEN 136 | Console.WriteChars("unable to create targetfile.\n"); 137 | Infile.Close(infile); 138 | infile := Infile.Nil; 139 | outfile := Outfile.Nil; 140 | passed := FALSE; 141 | RETURN 142 | END; (* IF *) 143 | 144 | (* all preflight checks passed *) 145 | passed := TRUE; 146 | END PreflightCheck; 147 | 148 | 149 | VAR 150 | passed : BOOLEAN; 151 | infile : InfileT; 152 | outfile : OutfileT; 153 | argStatus : ArgParser.Status; 154 | fsStatus : BasicFileSys.Status; 155 | 156 | 157 | BEGIN (* M2BSK *) 158 | (* check if program argument file is present *) 159 | IF fileExists(Args.Filename) THEN 160 | Args.Open 161 | ELSE (* query user and write file *) 162 | Args.Query 163 | END; (* IF *) 164 | 165 | argStatus := ArgParser.parseArgs(); 166 | Args.Close; 167 | Args.Delete; 168 | 169 | CASE argStatus OF 170 | Success : 171 | PrintBanner; 172 | 173 | PreflightCheck(infile, outfile, passed); 174 | 175 | IF passed THEN 176 | Compiler.Compile(infile, outfile); 177 | Infile.Close(infile); 178 | Outfile.Close(outfile) 179 | ELSE 180 | (* unable to proceed *) 181 | END (* IF *) 182 | 183 | | HelpRequested : 184 | PrintUsage 185 | 186 | | VersionRequested : 187 | Console.WriteChars(Version) 188 | 189 | | LicenseRequested : 190 | Console.WriteChars(Copyright); 191 | Console.WriteChars(License) 192 | 193 | | BuildInfoRequested : 194 | PrintBuildInfo 195 | 196 | | ErrorsEncountered : 197 | (* TO DO *) 198 | END (* CASE *) 199 | END M2BSK. 200 | -------------------------------------------------------------------------------- /src/imp/Primitive.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE Primitive; 4 | 5 | FROM String IMPORT StringT; 6 | 7 | 8 | PROCEDURE isPrimitive ( lexeme : StringT ) : BOOLEAN; 9 | (* Returns TRUE if lexeme represents a primitive identifier, else FALSE. *) 10 | 11 | BEGIN 12 | IF lexeme = NIL THEN 13 | (* TO DO : error message *) 14 | HALT 15 | END; (* IF *) 16 | 17 | CASE String.length(lexeme) OF 18 | 6 : 19 | CASE String.charAtIndex(lexeme, 1) OF 20 | 'A' : 21 | 22 | (* '_ALLOC' *) 23 | 24 | IF lexeme = alloc THEN 25 | RETURN TRUE 26 | END (* IF *) 27 | 28 | | 'S' : 29 | 30 | (* '_STDIN' *) 31 | 32 | IF lexeme = stdin THEN 33 | RETURN TRUE 34 | END (* IF *) 35 | 36 | END (* CASE *) 37 | 38 | | 7 : 39 | CASE String.charAtIndex(lexeme, 1) OF 40 | 'K' : 41 | 42 | (* '_KVALUE' *) 43 | 44 | IF lexeme = kvalue THEN 45 | RETURN TRUE 46 | END (* IF *) 47 | 48 | | 'S' : 49 | 50 | (* '_STDOUT' *) 51 | 52 | IF lexeme = stdout THEN 53 | RETURN TRUE 54 | END (* IF *) 55 | 56 | END (* CASE *) 57 | 58 | | 8 : 59 | CASE String.charAtIndex(lexeme, 2) OF 60 | 'T' : 61 | 62 | (* '_ATSTORE' *) 63 | 64 | IF lexeme = atstore THEN 65 | RETURN TRUE 66 | 67 | (* '_ATVALUE' *) 68 | 69 | ELSIF lexeme = atvalue THEN 70 | RETURN TRUE 71 | END (* IF *) 72 | 73 | | 'E' : 74 | 75 | (* '_DEALLOC' *) 76 | 77 | IF lexeme = dealloc THEN 78 | RETURN TRUE 79 | END (* IF *) 80 | 81 | | 'V' : 82 | 83 | (* '_KVSTORE' *) 84 | 85 | IF lexeme = kvstore THEN 86 | RETURN TRUE 87 | END (* IF *) 88 | 89 | END (* CASE *) 90 | 91 | | 9 : 92 | CASE String.charAtIndex(lexeme, 3) OF 93 | 'I' : 94 | 95 | (* '_ATINSERT' *) 96 | 97 | IF lexeme = atinsert THEN 98 | RETURN TRUE 99 | END (* IF *) 100 | 101 | | 'R' : 102 | 103 | (* '_ATREMOVE' *) 104 | 105 | IF lexeme = atremove THEN 106 | RETURN TRUE 107 | END (* IF *) 108 | 109 | END (* CASE *) 110 | 111 | END; (* CASE *) 112 | 113 | (* no match *) 114 | RETURN FALSE 115 | END isPrimitive; 116 | 117 | 118 | BEGIN (* initialise lexemes *) 119 | alloc := String.forArray("_ALLOC"); 120 | atinsert := String.forArray("_ATINSERT"); 121 | atremove := String.forArray("_ATREMOVE"); 122 | atstore := String.forArray("_ATSTORE"); 123 | atvalue := String.forArray("_ATVALUE"); 124 | dealloc := String.forArray("_DEALLOC"); 125 | kvalue := String.forArray("_KVALUE"); 126 | kvstore := String.forArray("_KVSTORE"); 127 | stdin := String.forArray("_STDIN"); 128 | stdout := String.forArray("_STDOUT") 129 | END Primitive. 130 | -------------------------------------------------------------------------------- /src/imp/Token.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | IMPLEMENTATION MODULE Token; 4 | 5 | (* Token Subranges *) 6 | 7 | TYPE 8 | Reswords = TokenT [Alias..Write]; 9 | Identifiers = TokenT [StdIdent..Primitive]; 10 | Numbers = TokenT [RealNumber..WholeNumber]; 11 | ConstExprLiterals = TokenT [WholeNumber..QuotedString]; 12 | CharsAndStrings = TokenT [CharCode..QuotedString]; 13 | NonRWOperL1 = TokenT [Equal..Identity]; 14 | NonRWOperL2 = TokenT [Plus..SetDiff]; 15 | NonRWOperL3 = TokenT [Asterisk..RealDiv]; 16 | 17 | 18 | (* Functions To Determine Token Classification *) 19 | 20 | PROCEDURE isResword ( t : TokenT ) : BOOLEAN; 21 | (* Returns TRUE if t is a reserved word, otherwise FALSE. *) 22 | BEGIN 23 | RETURN (t >= MIN(Reswords) AND t <= MAX(Reswords)) 24 | END isResword; 25 | 26 | 27 | PROCEDURE isIdentifier ( t : TokenT ) : BOOLEAN; 28 | (* Returns TRUE if t is an identifier, otherwise FALSE. *) 29 | BEGIN 30 | RETURN (t >= MIN(Identifiers) AND t <= MAX(Identifiers)) 31 | END isIdentifier; 32 | 33 | 34 | PROCEDURE isNumber ( t : TokenT ) : BOOLEAN; 35 | (* Returns TRUE if t is a number literal, otherwise FALSE. *) 36 | BEGIN 37 | RETURN (t >= MIN(Numbers) AND t <= MAX(Numbers)) 38 | END isNumber; 39 | 40 | 41 | PROCEDURE isCharOrString ( t : TokenT ) : BOOLEAN; 42 | (* Returns TRUE if t is a character or string, otherwise FALSE. *) 43 | BEGIN 44 | RETURN (t >= MIN(CharsAndStrings) AND t <= MAX(CharsAndStrings)) 45 | END isCharOrString; 46 | 47 | 48 | PROCEDURE isConstExprLiteral ( t : TokenT ) : BOOLEAN; 49 | (* Returns TRUE if t is a constant expression literal, otherwise FALSE. *) 50 | BEGIN 51 | RETURN (t >= MIN(ConstExprLiterals) AND t <= MAX(ConstExprLiterals)) 52 | END isConstExprLiteral; 53 | 54 | 55 | PROCEDURE isOperL1 ( t : TokenT ) : BOOLEAN; 56 | (* Returns TRUE if t is a level-1 operator, otherwise FALSE. *) 57 | BEGIN 58 | RETURN 59 | (t = In) OR 60 | (t >= MIN(OperatorsL1) AND t <= MAX(OperatorsL1)) 61 | END isOperL1; 62 | 63 | 64 | PROCEDURE isOperL2 ( t : TokenT ) : BOOLEAN; 65 | (* Returns TRUE if t is a level-2 operator, otherwise FALSE. *) 66 | BEGIN 67 | RETURN 68 | (t = Or) OR 69 | (t >= MIN(NonRWOperL2) AND t <= MAX(NonRWOperL2)) 70 | END isOperL2; 71 | 72 | 73 | PROCEDURE isOperL3 ( t : TokenT ) : BOOLEAN; 74 | (* Returns TRUE if t is a level-3 operator, otherwise FALSE. *) 75 | BEGIN 76 | RETURN 77 | (t = And) OR (t = Div) OR (t = Mod) OR 78 | (t >= MIN(NonRWOperL2) AND t <= MAX(NonRWOperL2)) 79 | END isOperL3; 80 | 81 | 82 | PROCEDURE isComment ( t : TokenT ) : BOOLEAN; 83 | (* Returns TRUE if t is a comment, otherwise FALSE. *) 84 | BEGIN 85 | RETURN (t = BlockComment) OR (t = LineComment) 86 | END isComment; 87 | 88 | 89 | PROCEDURE isPragma ( t : TokenT ) : BOOLEAN; 90 | (* Returns TRUE if t is a pragma, otherwise FALSE. *) 91 | BEGIN 92 | RETURN (t = Pragma) 93 | END isPragma; 94 | 95 | 96 | END Token. 97 | -------------------------------------------------------------------------------- /src/lib/AOC.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE AOC; 4 | 5 | (* Character Array Types *) 6 | 7 | TYPE Len1 = ARRAY [0..1] OF CHAR; 8 | TYPE Len2 = ARRAY [0..2] OF CHAR; 9 | TYPE Len3 = ARRAY [0..3] OF CHAR; 10 | TYPE Len4 = ARRAY [0..4] OF CHAR; 11 | TYPE Len5 = ARRAY [0..5] OF CHAR; 12 | TYPE Len6 = ARRAY [0..6] OF CHAR; 13 | TYPE Len7 = ARRAY [0..7] OF CHAR; 14 | TYPE Len8 = ARRAY [0..8] OF CHAR; 15 | TYPE Len9 = ARRAY [0..9] OF CHAR; 16 | TYPE Len10 = ARRAY [0..10] OF CHAR; 17 | TYPE Len11 = ARRAY [0..11] OF CHAR; 18 | TYPE Len12 = ARRAY [0..12] OF CHAR; 19 | TYPE Len13 = ARRAY [0..13] OF CHAR; 20 | TYPE Len14 = ARRAY [0..14] OF CHAR; 21 | TYPE Len15 = ARRAY [0..15] OF CHAR; 22 | TYPE Len16 = ARRAY [0..16] OF CHAR; 23 | TYPE Len17 = ARRAY [0..17] OF CHAR; 24 | TYPE Len18 = ARRAY [0..18] OF CHAR; 25 | TYPE Len19 = ARRAY [0..19] OF CHAR; 26 | TYPE Len20 = ARRAY [0..20] OF CHAR; 27 | TYPE Len21 = ARRAY [0..21] OF CHAR; 28 | TYPE Len22 = ARRAY [0..22] OF CHAR; 29 | TYPE Len23 = ARRAY [0..23] OF CHAR; 30 | TYPE Len24 = ARRAY [0..24] OF CHAR; 31 | TYPE Len25 = ARRAY [0..25] OF CHAR; 32 | TYPE Len26 = ARRAY [0..26] OF CHAR; 33 | TYPE Len27 = ARRAY [0..27] OF CHAR; 34 | TYPE Len28 = ARRAY [0..28] OF CHAR; 35 | TYPE Len29 = ARRAY [0..29] OF CHAR; 36 | TYPE Len30 = ARRAY [0..30] OF CHAR; 37 | TYPE Len31 = ARRAY [0..31] OF CHAR; 38 | TYPE Len32 = ARRAY [0..32] OF CHAR; 39 | TYPE Len33 = ARRAY [0..33] OF CHAR; 40 | TYPE Len34 = ARRAY [0..34] OF CHAR; 41 | TYPE Len35 = ARRAY [0..35] OF CHAR; 42 | TYPE Len36 = ARRAY [0..36] OF CHAR; 43 | TYPE Len37 = ARRAY [0..37] OF CHAR; 44 | TYPE Len38 = ARRAY [0..38] OF CHAR; 45 | TYPE Len39 = ARRAY [0..39] OF CHAR; 46 | TYPE Len40 = ARRAY [0..40] OF CHAR; 47 | TYPE Len41 = ARRAY [0..41] OF CHAR; 48 | TYPE Len42 = ARRAY [0..42] OF CHAR; 49 | TYPE Len43 = ARRAY [0..43] OF CHAR; 50 | TYPE Len44 = ARRAY [0..44] OF CHAR; 51 | TYPE Len45 = ARRAY [0..45] OF CHAR; 52 | TYPE Len46 = ARRAY [0..46] OF CHAR; 53 | TYPE Len47 = ARRAY [0..47] OF CHAR; 54 | TYPE Len48 = ARRAY [0..48] OF CHAR; 55 | TYPE Len49 = ARRAY [0..49] OF CHAR; 56 | TYPE Len50 = ARRAY [0..50] OF CHAR; 57 | TYPE Len51 = ARRAY [0..51] OF CHAR; 58 | TYPE Len52 = ARRAY [0..52] OF CHAR; 59 | TYPE Len53 = ARRAY [0..53] OF CHAR; 60 | TYPE Len54 = ARRAY [0..54] OF CHAR; 61 | TYPE Len55 = ARRAY [0..55] OF CHAR; 62 | TYPE Len56 = ARRAY [0..56] OF CHAR; 63 | TYPE Len57 = ARRAY [0..57] OF CHAR; 64 | TYPE Len58 = ARRAY [0..58] OF CHAR; 65 | TYPE Len59 = ARRAY [0..59] OF CHAR; 66 | TYPE Len60 = ARRAY [0..60] OF CHAR; 67 | TYPE Len61 = ARRAY [0..61] OF CHAR; 68 | TYPE Len62 = ARRAY [0..62] OF CHAR; 69 | TYPE Len63 = ARRAY [0..63] OF CHAR; 70 | TYPE Len64 = ARRAY [0..64] OF CHAR; 71 | TYPE Len65 = ARRAY [0..65] OF CHAR; 72 | TYPE Len66 = ARRAY [0..66] OF CHAR; 73 | TYPE Len67 = ARRAY [0..67] OF CHAR; 74 | TYPE Len68 = ARRAY [0..68] OF CHAR; 75 | TYPE Len69 = ARRAY [0..69] OF CHAR; 76 | TYPE Len70 = ARRAY [0..70] OF CHAR; 77 | TYPE Len71 = ARRAY [0..71] OF CHAR; 78 | TYPE Len72 = ARRAY [0..72] OF CHAR; 79 | TYPE Len73 = ARRAY [0..73] OF CHAR; 80 | TYPE Len74 = ARRAY [0..74] OF CHAR; 81 | TYPE Len75 = ARRAY [0..75] OF CHAR; 82 | TYPE Len76 = ARRAY [0..76] OF CHAR; 83 | TYPE Len77 = ARRAY [0..77] OF CHAR; 84 | TYPE Len78 = ARRAY [0..78] OF CHAR; 85 | TYPE Len79 = ARRAY [0..79] OF CHAR; 86 | TYPE Len80 = ARRAY [0..80] OF CHAR; 87 | TYPE Len96 = ARRAY [0..96] OF CHAR; 88 | TYPE Len112 = ARRAY [0..112] OF CHAR; 89 | TYPE Len128 = ARRAY [0..128] OF CHAR; 90 | TYPE Len256 = ARRAY [0..256] OF CHAR; 91 | TYPE Len384 = ARRAY [0..384] OF CHAR; 92 | TYPE Len512 = ARRAY [0..512] OF CHAR; 93 | TYPE Len768 = ARRAY [0..768] OF CHAR; 94 | TYPE Len1024 = ARRAY [0..1024] OF CHAR; 95 | TYPE Len1280 = ARRAY [0..1280] OF CHAR; 96 | TYPE Len1792 = ARRAY [0..1792] OF CHAR; 97 | TYPE Len2048 = ARRAY [0..2048] OF CHAR; 98 | TYPE Len2304 = ARRAY [0..2304] OF CHAR; 99 | TYPE Len2560 = ARRAY [0..2560] OF CHAR; 100 | TYPE Len2816 = ARRAY [0..2816] OF CHAR; 101 | TYPE Len3072 = ARRAY [0..3072] OF CHAR; 102 | TYPE Len3328 = ARRAY [0..3328] OF CHAR; 103 | TYPE Len3584 = ARRAY [0..3584] OF CHAR; 104 | TYPE Len3840 = ARRAY [0..3840] OF CHAR; 105 | TYPE Len4096 = ARRAY [0..4096] OF CHAR; 106 | 107 | (* Largest AOC Type *) 108 | 109 | TYPE Largest = Len4096; 110 | 111 | END AOC. 112 | -------------------------------------------------------------------------------- /src/lib/CARD64/Card64BitOps.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Card64BitOps; (* universal version *) 4 | 5 | (* Bit Operations on Type CARD64 *) 6 | 7 | 8 | FROM SYSTEM IMPORT TSIZE; 9 | FROM CARD64 IMPORT Card64T; 10 | 11 | 12 | (* --------------------------------------------------------------------------- 13 | * Bit Index Type 14 | * ------------------------------------------------------------------------ *) 15 | 16 | CONST Bitwidth = TSIZE(Card64T) * 8; 17 | 18 | TYPE BitIndex = CARDINAL [0..Bitwidth-1]; 19 | 20 | 21 | (* --------------------------------------------------------------------------- 22 | * Procedure: Shl( n, shiftFactor ) 23 | * --------------------------------------------------------------------------- 24 | * Passes n shifted left by shiftFactor in n. 25 | * ------------------------------------------------------------------------ *) 26 | 27 | PROCEDURE Shl ( VAR n : Card64T; shiftFactor : BitIndex ); 28 | 29 | 30 | (* --------------------------------------------------------------------------- 31 | * Procedure: Shr( n, shiftFactor ) 32 | * --------------------------------------------------------------------------- 33 | * Passes n logically shifted right by shiftFactor in n. 34 | * ------------------------------------------------------------------------ *) 35 | 36 | PROCEDURE Shr ( VAR n : Card64T; shiftFactor : BitIndex ); 37 | 38 | 39 | (* --------------------------------------------------------------------------- 40 | * Procedure: AShr( n, shiftFactor ) 41 | * --------------------------------------------------------------------------- 42 | * Passes n arithmetically shifted right by shiftFactor in n. 43 | * ------------------------------------------------------------------------ *) 44 | 45 | PROCEDURE AShr ( VAR n : Card64T; shiftFactor : BitIndex ); 46 | 47 | 48 | (* --------------------------------------------------------------------------- 49 | * Function: bit( n, bitIndex ) 50 | * --------------------------------------------------------------------------- 51 | * Returns TRUE if the bit at bitIndex of n is set, otherwise FALSE. 52 | * ------------------------------------------------------------------------ *) 53 | 54 | PROCEDURE bit ( n : Card64T; bitIndex : BitIndex ) : BOOLEAN; 55 | 56 | 57 | (* --------------------------------------------------------------------------- 58 | * Procedure: SetBit( n, bitIndex ) 59 | * --------------------------------------------------------------------------- 60 | * Sets the bit at bitIndex of n. 61 | * ------------------------------------------------------------------------ *) 62 | 63 | PROCEDURE SetBit ( VAR n : Card64T; bitIndex : BitIndex ); 64 | 65 | 66 | (* --------------------------------------------------------------------------- 67 | * Procedure: ClearBit( n, bitIndex ) 68 | * --------------------------------------------------------------------------- 69 | * Clears the bit at bitIndex of n. 70 | * ------------------------------------------------------------------------ *) 71 | 72 | PROCEDURE ClearBit ( VAR n : Card64T; bitIndex : BitIndex ); 73 | 74 | 75 | (* --------------------------------------------------------------------------- 76 | * Procedure: ClearLSBtoN( n, bitIndex ) 77 | * --------------------------------------------------------------------------- 78 | * Clears the bits of n in range [0 .. bitIndex]. 79 | * ------------------------------------------------------------------------ *) 80 | 81 | PROCEDURE ClearLSBtoN ( VAR n : Card64T; bitIndex : BitIndex ); 82 | 83 | 84 | (* --------------------------------------------------------------------------- 85 | * Procedure: ClearMSBtoN( n, bitIndex ) 86 | * --------------------------------------------------------------------------- 87 | * Clears the bits of n in range [bitIndex .. Bitwidth-1]. 88 | * ------------------------------------------------------------------------ *) 89 | 90 | PROCEDURE ClearMSBtoN ( VAR n : Card64T; bitIndex : BitIndex ); 91 | 92 | 93 | END Card64BitOps. -------------------------------------------------------------------------------- /src/lib/CARD64/Card64Math.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Card64Math; (* universal version *) 4 | 5 | (* CARD64 Math Library *) 6 | 7 | 8 | FROM SYSTEM IMPORT TSIZE; 9 | FROM CARD64 IMPORT Card64T; 10 | 11 | 12 | (* --------------------------------------------------------------------------- 13 | * Bitwidth 14 | * ------------------------------------------------------------------------ *) 15 | 16 | CONST Bitwidth = TSIZE(Card64T) * 8; 17 | 18 | 19 | (* -------------------------------------------------------------------------- 20 | * Procedure: Card64Math.Pow2(n) 21 | * -------------------------------------------------------------------------- 22 | * Passes the power of 2 for argument n in result. 23 | * ----------------------------------------------------------------------- *) 24 | 25 | TYPE Pow2Arg = CARDINAL [0 .. Bitwidth-1]; 26 | 27 | PROCEDURE Pow2 ( VAR result : Card64T; n : Pow2Arg ); 28 | 29 | 30 | (* -------------------------------------------------------------------------- 31 | * Procedure: Card64Math.Log2(n) 32 | * -------------------------------------------------------------------------- 33 | * Passes the integral part of the logarithm of 2 for argument n in result. 34 | * ----------------------------------------------------------------------- *) 35 | 36 | PROCEDURE Log2 ( VAR result : Card64T; n : Card64T ); 37 | 38 | 39 | (* -------------------------------------------------------------------------- 40 | * Procedure: Card64Math.Pow10(n) 41 | * -------------------------------------------------------------------------- 42 | * Passes the power of 10 for argument n in result. 43 | * ----------------------------------------------------------------------- *) 44 | 45 | TYPE Pow10Arg = CARDINAL [0 .. 18]; 46 | 47 | PROCEDURE Pow10 ( VAR result : Card64T; n : Pow10Arg ); 48 | 49 | 50 | (* -------------------------------------------------------------------------- 51 | * Procedure: Card64Math.Log10(n) 52 | * -------------------------------------------------------------------------- 53 | * Passes the integral part of the logarithm of 10 for argument n in result. 54 | * ----------------------------------------------------------------------- *) 55 | 56 | PROCEDURE Log10 ( VAR result : Card64T; n : Card64T ); 57 | 58 | 59 | (* -------------------------------------------------------------------------- 60 | * Function: Card64Math.addOverflows(n, m) 61 | * -------------------------------------------------------------------------- 62 | * Returns TRUE if operation n + m overflows, else FALSE. 63 | * ----------------------------------------------------------------------- *) 64 | 65 | PROCEDURE addOverflows ( n, m : Card64T ) : BOOLEAN; 66 | 67 | 68 | (* -------------------------------------------------------------------------- 69 | * Procedure: Card64T.TwosComplement(n) 70 | * -------------------------------------------------------------------------- 71 | * Passes the two's complement of n in n. 72 | * ----------------------------------------------------------------------- *) 73 | 74 | PROCEDURE TwosComplement ( VAR n : Card64T ); 75 | 76 | 77 | END Card64Math. -------------------------------------------------------------------------------- /src/lib/CARD64/README.md: -------------------------------------------------------------------------------- 1 | ### The 64-bit Cardinal Library ### 2 | 3 | The 64-bit Cardinal library provides a 64-bit Cardinal type and consists of three modules 4 | 5 | * Module `CARD64` provides the type definition, relational and arithmetic operations 6 | * Module `Card64BitOps` provides bitwise operations on the type 7 | * Module `Card64Math` provides extended math operations 8 | 9 | ### Memory Models ### 10 | 11 | There are three possible memory models employed by classical Modula-2 compilers 12 | 13 | * 16-bit `CARDINAL` and 32-bit `LONGINT`, abbreviated 16/32 14 | * 32-bit `CARDINAL` and 32-bit `LONGINT`, abbreviated 32/32 15 | * 32-bit `CARDINAL` and 64-bit `LONGINT`, abbreviated 32/64 16 | 17 | ### Memory Model Specific Library Versions ### 18 | 19 | In order to support any given memory model, two separate implementations of the library are provided 20 | 21 | * a version based on 32-bit `LONGINT`, to be used for the 16/32 memory model 22 | * a version based on 32-bit `CARDINAL`, to be used for the 32/32 and 32/64 memory models 23 | 24 | ### Filename Version Nomenclature ### 25 | 26 | * Files specific to the 32-bit `LONGINT` versions contain `LONGINT32` in their filename. 27 | * Files specific to the 32-bit `CARDINAL` versions contain `CARDINAL32` in their filename. 28 | -------------------------------------------------------------------------------- /src/lib/CardBitOps.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE CardBitOps; (* portable *) 4 | 5 | (* Bit Operations on Type CARDINAL *) 6 | 7 | 8 | CONST Bitwidth = TSIZE(CARDINAL) * 8 - 1; 9 | 10 | TYPE BitIndex = CARDINAL [0..Bitwidth-1]; 11 | 12 | 13 | (* --------------------------------------------------------------------------- 14 | * function shl( n, shiftFactor ) 15 | * --------------------------------------------------------------------------- 16 | * Returns n shifted left by shiftFactor. 17 | * ------------------------------------------------------------------------ *) 18 | 19 | PROCEDURE shl ( n : CARDINAL; shiftFactor : BitIndex ) : CARDINAL; 20 | 21 | 22 | (* --------------------------------------------------------------------------- 23 | * function shr( n, shiftFactor ) 24 | * --------------------------------------------------------------------------- 25 | * Returns n logically shifted right by shiftFactor. 26 | * ------------------------------------------------------------------------ *) 27 | 28 | PROCEDURE shr ( n : CARDINAL; shiftFactor : BitIndex ) : CARDINAL; 29 | 30 | 31 | (* --------------------------------------------------------------------------- 32 | * function ashr( n, shiftFactor ) 33 | * --------------------------------------------------------------------------- 34 | * Returns n arithmetically shifted right by shiftFactor. 35 | * ------------------------------------------------------------------------ *) 36 | 37 | PROCEDURE ashr ( n : CARDINAL; shiftFactor : BitIndex ) : CARDINAL; 38 | 39 | 40 | (* --------------------------------------------------------------------------- 41 | * procedure SHLC( n, carryBits, bitIndex ) 42 | * --------------------------------------------------------------------------- 43 | * Left-shifts n by bitIndex and passes the shifted out bits in carryBits. 44 | * ------------------------------------------------------------------------ *) 45 | 46 | PROCEDURE SHLC ( VAR n, carryBits : CARDINAL; bitIndex : BitIndex ); 47 | 48 | 49 | (* --------------------------------------------------------------------------- 50 | * function bit( n, bitIndex ) 51 | * --------------------------------------------------------------------------- 52 | * Returns TRUE if the bit at bitIndex of n is set, otherwise FALSE. 53 | * ------------------------------------------------------------------------ *) 54 | 55 | PROCEDURE bit ( n : CARDINAL; bitIndex : BitIndex ) : CARDINAL; 56 | 57 | 58 | (* --------------------------------------------------------------------------- 59 | * procedure SetBit( n, bitIndex ) 60 | * --------------------------------------------------------------------------- 61 | * Sets the bit at bitIndex of n. 62 | * ------------------------------------------------------------------------ *) 63 | 64 | PROCEDURE SetBit ( VAR n : CARDINAL; bitIndex : BitIndex ); 65 | 66 | 67 | (* --------------------------------------------------------------------------- 68 | * procedure ClearBit( n, bitIndex ) 69 | * --------------------------------------------------------------------------- 70 | * Clears the bit at bitIndex of n. 71 | * ------------------------------------------------------------------------ *) 72 | 73 | PROCEDURE ClearBit ( VAR n : CARDINAL; bitIndex : BitIndex ); 74 | 75 | 76 | (* --------------------------------------------------------------------------- 77 | * procedure ClearLSBtoN( n, bitIndex ) 78 | * --------------------------------------------------------------------------- 79 | * Clears the bits of n in range [0 .. bitIndex]. 80 | * ------------------------------------------------------------------------ *) 81 | 82 | PROCEDURE ClearLSBtoN ( VAR n : CARDINAL; bitIndex : BitIndex ); 83 | 84 | 85 | (* --------------------------------------------------------------------------- 86 | * procedure ClearMSBtoN( n, bitIndex ) 87 | * --------------------------------------------------------------------------- 88 | * Clears the bits of n in range [bitIndex .. Bitwidth-1]. 89 | * ------------------------------------------------------------------------ *) 90 | 91 | PROCEDURE ClearMSBtoN ( VAR n : CARDINAL; bitIndex : BitIndex ); 92 | 93 | 94 | END CardBitOps. -------------------------------------------------------------------------------- /src/lib/CardMath.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE CardMath; 4 | 5 | (* Cardinal Math library *) 6 | 7 | 8 | (* Math operations *) 9 | 10 | (* -------------------------------------------------------------------------- 11 | * function abs(i) 12 | * -------------------------------------------------------------------------- 13 | * Returns the absolute CARDINAL value of INTEGER i 14 | * ----------------------------------------------------------------------- *) 15 | 16 | PROCEDURE abs ( i : INTEGER ) : CARDINAL; 17 | 18 | 19 | (* -------------------------------------------------------------------------- 20 | * function pow2(n) 21 | * -------------------------------------------------------------------------- 22 | * Returns the power of 2 for argument n 23 | * ----------------------------------------------------------------------- *) 24 | 25 | PROCEDURE pow2 ( n : CARDINAL ) : CARDINAL; 26 | 27 | 28 | (* -------------------------------------------------------------------------- 29 | * function log2(n) 30 | * -------------------------------------------------------------------------- 31 | * Returns the integral part of the logarithm of 2 for argument n 32 | * ----------------------------------------------------------------------- *) 33 | 34 | PROCEDURE log2 ( n : CARDINAL ) : CARDINAL; 35 | 36 | 37 | (* -------------------------------------------------------------------------- 38 | * function pow10(n) 39 | * -------------------------------------------------------------------------- 40 | * Returns the power of 10 for argument n 41 | * ----------------------------------------------------------------------- *) 42 | 43 | PROCEDURE pow10 ( n : CARDINAL ) : CARDINAL; 44 | 45 | 46 | (* -------------------------------------------------------------------------- 47 | * function log10(n) 48 | * -------------------------------------------------------------------------- 49 | * Returns the integral part of the logarithm of 10 for argument n 50 | * ----------------------------------------------------------------------- *) 51 | 52 | PROCEDURE log10 ( n : CARDINAL ) : CARDINAL; 53 | 54 | 55 | (* -------------------------------------------------------------------------- 56 | * function maxDecimalDigits(n) 57 | * -------------------------------------------------------------------------- 58 | * Returns the number of decimal digits of the largest unsigned integer that 59 | * can be encoded in base-2 using n number of 8-bit octets for 1 <= n <= 16. 60 | * ----------------------------------------------------------------------- *) 61 | 62 | TYPE Card1To16 = CARDINAL [1..16]; (* max 128 bits *) 63 | 64 | PROCEDURE maxDecimalDigits ( octets : Card1To16 ) : CARDINAL; 65 | 66 | 67 | (* -------------------------------------------------------------------------- 68 | * function twosComplement(n) 69 | * -------------------------------------------------------------------------- 70 | * Returns the two's complement of n 71 | * ----------------------------------------------------------------------- *) 72 | 73 | PROCEDURE twosComplement ( n : CARDINAL ) : CARDINAL; 74 | 75 | 76 | (* -------------------------------------------------------------------------- 77 | * function addOverflows(n, m) 78 | * -------------------------------------------------------------------------- 79 | * Returns TRUE if operation n + m overflows, else FALSE. 80 | * ----------------------------------------------------------------------- *) 81 | 82 | PROCEDURE addOverflows ( n, m : CARDINAL ) : BOOLEAN; 83 | 84 | 85 | (* Bit operations *) 86 | 87 | (* -------------------------------------------------------------------------- 88 | * function shl(n, shiftFactor) 89 | * -------------------------------------------------------------------------- 90 | * Returns the value of n, shifted left by shiftFactor. 91 | * ----------------------------------------------------------------------- *) 92 | 93 | PROCEDURE shl ( n, shiftFactor : CARDINAL ) : CARDINAL; 94 | 95 | 96 | (* -------------------------------------------------------------------------- 97 | * function shr(n, shiftFactor) 98 | * -------------------------------------------------------------------------- 99 | * Returns the value of n, shifted right by shiftFactor. 100 | * ----------------------------------------------------------------------- *) 101 | 102 | PROCEDURE shr ( n, shiftFactor : CARDINAL ) : CARDINAL; 103 | 104 | 105 | (* -------------------------------------------------------------------------- 106 | * function MSB(n) 107 | * -------------------------------------------------------------------------- 108 | * Returns TRUE if the most significant bit of n is set, else FALSE. 109 | * ----------------------------------------------------------------------- *) 110 | 111 | PROCEDURE MSB ( n : CARDINAL ) : BOOLEAN; 112 | 113 | 114 | (* -------------------------------------------------------------------------- 115 | * procedure SetMSB(n) 116 | * -------------------------------------------------------------------------- 117 | * Sets the most significant bit of n. 118 | * ----------------------------------------------------------------------- *) 119 | 120 | PROCEDURE SetMSB ( VAR n : CARDINAL ); 121 | 122 | 123 | (* -------------------------------------------------------------------------- 124 | * procedure ClearMSB(n) 125 | * -------------------------------------------------------------------------- 126 | * Clears the most significant bit of n. 127 | * ----------------------------------------------------------------------- *) 128 | 129 | PROCEDURE ClearMSB ( VAR n : CARDINAL ); 130 | 131 | 132 | (* -------------------------------------------------------------------------- 133 | * procedure ClearHighestNBits(value, n) 134 | * -------------------------------------------------------------------------- 135 | * Clears bits [MSB..MSB-n] of value. 136 | * ----------------------------------------------------------------------- *) 137 | 138 | PROCEDURE ClearHighestNBits ( VAR value : CARDINAL; n : CARDINAL ); 139 | 140 | 141 | END CardMath. 142 | -------------------------------------------------------------------------------- /src/lib/Char.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Char; 4 | 5 | (* Character tests and conversions *) 6 | 7 | 8 | (* Tests *) 9 | 10 | PROCEDURE isControl ( ch : CHAR ) : BOOLEAN; 11 | (* Returns TRUE if ch is a control code, otherwise FALSE. *) 12 | 13 | PROCEDURE isDigit ( ch : CHAR ) : BOOLEAN; 14 | (* Returns TRUE if ch is a digit, otherwise FALSE. *) 15 | 16 | PROCEDURE isAtoF ( ch : CHAR ) : BOOLEAN; 17 | (* Returns TRUE if ch is a base-16 digit, otherwise FALSE. *) 18 | 19 | PROCEDURE isLetter ( ch : CHAR ) : BOOLEAN; 20 | (* Returns TRUE if ch is a letter, otherwise FALSE. *) 21 | 22 | PROCEDURE isUpper ( ch : CHAR ) : BOOLEAN; 23 | (* Returns TRUE if ch is an uppercase letter, otherwise FALSE. *) 24 | 25 | PROCEDURE isLower ( ch : CHAR ) : BOOLEAN; 26 | (* Returns TRUE if ch is a lowercase letter, otherwise FALSE. *) 27 | 28 | PROCEDURE isAlphaNum ( ch : CHAR ) : BOOLEAN; 29 | (* Returns TRUE if ch is alpha-numeric, otherwise FALSE. *) 30 | 31 | PROCEDURE isPrintable ( ch : CHAR ) : BOOLEAN; 32 | (* Returns TRUE if ch is printable, otherwise FALSE. *) 33 | 34 | PROCEDURE isQuotable ( ch : CHAR ) : BOOLEAN; 35 | (* Returns TRUE if ch is quotable, otherwise FALSE. *) 36 | 37 | PROCEDURE isEscapable ( ch : CHAR ) : BOOLEAN; 38 | (* Returns TRUE if ch is escapable, otherwise FALSE. *) 39 | 40 | 41 | (* Conversions *) 42 | 43 | PROCEDURE toUpper ( ch : CHAR ) : CHAR; 44 | (* Returns the uppercase equivalent of ch if ch is a lowercase letter. 45 | Otherwise returns ch. *) 46 | 47 | PROCEDURE ToUpper ( VAR ch : CHAR ); 48 | (* Replaces ch with its uppercase equivalent if ch is a lowercase letter. *) 49 | 50 | PROCEDURE toLower ( ch : CHAR ) : CHAR; 51 | (* Returns the lowercase equivalent of ch if ch is an uppercase letter. 52 | Otherwise returns ch. *) 53 | 54 | PROCEDURE ToLower ( VAR ch : CHAR ); 55 | (* Replaces ch with its lowercase equivalent if ch is a uppercase letter. *) 56 | 57 | 58 | END Char. 59 | -------------------------------------------------------------------------------- /src/lib/Hash/Hash.CARDINAL32.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Hash; (* 32-bit CARDINAL version *) 4 | 5 | (* General Purpose 32-bit Hash Function *) 6 | 7 | 8 | FROM SYSTEM IMPORT TSIZE; 9 | 10 | 11 | (* --------------------------------------------------------------------------- 12 | * 32-bit key type 13 | * ------------------------------------------------------------------------ *) 14 | 15 | TYPE Key = CARDINAL; (* requires 32-bit CARDINAL *) 16 | 17 | 18 | (* --------------------------------------------------------------------------- 19 | * Key bitwidth 20 | * ------------------------------------------------------------------------ *) 21 | 22 | CONST Bitwidth = TSIZE(Key) * 8; 23 | 24 | 25 | (* --------------------------------------------------------------------------- 26 | * Initial value for incremental hash calculation 27 | * ------------------------------------------------------------------------ *) 28 | 29 | CONST InitialValue = 0; 30 | 31 | 32 | (* --------------------------------------------------------------------------- 33 | * Function: Hash.valueForNextChar( hash, ch ) 34 | * ------------------------------------------------------------------------ *) 35 | 36 | PROCEDURE valueForNextChar ( hash : Key; ch : CHAR ) : Key; 37 | 38 | 39 | (* --------------------------------------------------------------------------- 40 | * Function: Hash.finalValue( hash ) 41 | * ------------------------------------------------------------------------ *) 42 | 43 | PROCEDURE finalValue ( hash : Key ) : Key; 44 | 45 | 46 | (* --------------------------------------------------------------------------- 47 | * Function: Hash.valueForArray( array ) 48 | * ------------------------------------------------------------------------ *) 49 | 50 | PROCEDURE valueForArray ( VAR (* CONST *) array : ARRAY OF CHAR ) : Key; 51 | 52 | 53 | END Hash. -------------------------------------------------------------------------------- /src/lib/Hash/Hash.LONGINT32.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Hash; (* 32-bit LONGINT version *) 4 | 5 | (* General Purpose 32-bit Hash Function *) 6 | 7 | 8 | FROM SYSTEM IMPORT TSIZE; 9 | 10 | 11 | (* --------------------------------------------------------------------------- 12 | * 32-bit key type 13 | * ------------------------------------------------------------------------ *) 14 | 15 | TYPE Key = LONGINT (* requires 32-bit LONGINT *) 16 | 17 | 18 | (* --------------------------------------------------------------------------- 19 | * Key bitwidth 20 | * ------------------------------------------------------------------------ *) 21 | 22 | CONST Bitwidth = TSIZE(Key) * 8; 23 | 24 | 25 | (* --------------------------------------------------------------------------- 26 | * Initial value for incremental hash calculation 27 | * ------------------------------------------------------------------------ *) 28 | 29 | CONST InitialValue = 0; 30 | 31 | 32 | (* --------------------------------------------------------------------------- 33 | * Function: Hash.valueForNextChar( hash, ch ) 34 | * ------------------------------------------------------------------------ *) 35 | 36 | PROCEDURE valueForNextChar ( hash : Key; ch : CHAR ) : Key; 37 | 38 | 39 | (* --------------------------------------------------------------------------- 40 | * Function: Hash.finalValue( hash ) 41 | * ------------------------------------------------------------------------ *) 42 | 43 | PROCEDURE finalValue ( hash : Key ) : Key; 44 | 45 | 46 | (* --------------------------------------------------------------------------- 47 | * Function: Hash.valueForArray( array ) 48 | * ------------------------------------------------------------------------ *) 49 | 50 | PROCEDURE valueForArray ( VAR (* CONST *) array : ARRAY OF CHAR ) : Key; 51 | 52 | 53 | END Hash. -------------------------------------------------------------------------------- /src/lib/Hash/LongHash.CARD64.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE LongHash; (* CARD64 version *) 4 | 5 | (* General Purpose 64-bit Hash Function *) 6 | 7 | 8 | FROM SYSTEM IMPORT TSIZE; 9 | FROM CARD64 IMPORT Card64T; 10 | 11 | 12 | (* --------------------------------------------------------------------------- 13 | * 64-bit key type 14 | * ------------------------------------------------------------------------ *) 15 | 16 | TYPE Key = Card64T; 17 | 18 | 19 | (* --------------------------------------------------------------------------- 20 | * Key bitwidth 21 | * ------------------------------------------------------------------------ *) 22 | 23 | CONST Bitwidth = TSIZE(Key) * 8; 24 | 25 | 26 | (* --------------------------------------------------------------------------- 27 | * Procedure: LongHash.SetInitialValue( hash ) 28 | * ------------------------------------------------------------------------ *) 29 | 30 | PROCEDURE SetInitialValue ( VAR hash : Key ); 31 | 32 | 33 | (* --------------------------------------------------------------------------- 34 | * Procedure: LongHash.ValueForNextChar( hash, ch ) 35 | * ------------------------------------------------------------------------ *) 36 | 37 | PROCEDURE ValueForNextChar ( VAR hash : Key; ch : CHAR ); 38 | 39 | 40 | (* --------------------------------------------------------------------------- 41 | * Procedure: LongHash.SetFinalValue( hash ) 42 | * ------------------------------------------------------------------------ *) 43 | 44 | PROCEDURE SetFinalValue ( VAR hash : Key ); 45 | 46 | 47 | (* --------------------------------------------------------------------------- 48 | * Procedure: Hash.ValueForArray( hash, array ) 49 | * ------------------------------------------------------------------------ *) 50 | 51 | PROCEDURE ValueForArray 52 | ( VAR hash : Key; VAR (* CONST *) array : ARRAY OF CHAR ); 53 | 54 | 55 | END LongHash. -------------------------------------------------------------------------------- /src/lib/Hash/LongHash.LONGINT64.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE LongHash; (* 64-bit LONGINT version *) 4 | 5 | (* General Purpose 64-bit Hash Function *) 6 | 7 | 8 | FROM SYSTEM IMPORT TSIZE; 9 | 10 | 11 | (* --------------------------------------------------------------------------- 12 | * 64-bit key type 13 | * ------------------------------------------------------------------------ *) 14 | 15 | TYPE Key = LONGINT; (* requires 64-bit LONGINT *) 16 | 17 | 18 | (* --------------------------------------------------------------------------- 19 | * Key bitwidth 20 | * ------------------------------------------------------------------------ *) 21 | 22 | CONST Bitwidth = TSIZE(Key) * 8; 23 | 24 | 25 | (* --------------------------------------------------------------------------- 26 | * Procedure: LongHash.SetInitialValue( hash ) 27 | * ------------------------------------------------------------------------ *) 28 | 29 | PROCEDURE SetInitialValue ( VAR hash : Key ); 30 | 31 | 32 | (* --------------------------------------------------------------------------- 33 | * Procedure: LongHash.ValueForNextChar( hash, ch ) 34 | * ------------------------------------------------------------------------ *) 35 | 36 | PROCEDURE ValueForNextChar ( VAR hash : Key; ch : CHAR ); 37 | 38 | 39 | (* --------------------------------------------------------------------------- 40 | * Procedure: LongHash.SetFinalValue( hash ) 41 | * ------------------------------------------------------------------------ *) 42 | 43 | PROCEDURE SetFinalValue ( VAR hash : Key ); 44 | 45 | 46 | (* --------------------------------------------------------------------------- 47 | * Procedure: Hash.ValueForArray( hash, array ) 48 | * ------------------------------------------------------------------------ *) 49 | 50 | PROCEDURE ValueForArray 51 | ( VAR hash : Key; VAR (* CONST *) array : ARRAY OF CHAR ); 52 | 53 | 54 | END LongHash. -------------------------------------------------------------------------------- /src/lib/Hash/README.md: -------------------------------------------------------------------------------- 1 | ### The Hash Library ### 2 | 3 | The Hash library provides two modules 4 | 5 | * Module `Hash` for 32-bit hash values 6 | * Module `LongHash` for 64-bit hash values 7 | 8 | ### Memory Models ### 9 | 10 | There are three possible memory models employed by classical Modula-2 compilers 11 | 12 | * 16-bit `CARDINAL` and 32-bit `LONGINT`, abbreviated 16/32 13 | * 32-bit `CARDINAL` and 32-bit `LONGINT`, abbreviated 32/32 14 | * 32-bit `CARDINAL` and 64-bit `LONGINT`, abbreviated 32/64 15 | 16 | ### Memory Model Specific Library Versions ### 17 | 18 | Depending on the memory model, a specific version of the Hash library must be used 19 | 20 | * for the 16/32 memory model, use `Hash.LONGINT32` and `LongHash.CARD64` 21 | * for the 32/32 memory model, use `Hash.CARDINAL32` and `LongHash.CARD64` 22 | * for the 32/64 memory model, use `Hash.CARDINAL32` and `LongHash.LONGINT64` 23 | -------------------------------------------------------------------------------- /src/lib/Hash/imp/Hash.CARDINAL32.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | IMPLEMENTATION MODULE Hash; (* 32-bit CARDINAL version *) 4 | 5 | (* General Purpose 32-bit Hash Function *) 6 | 7 | 8 | IMPORT ISO646, Console; 9 | 10 | FROM SYSTEM IMPORT TSIZE; 11 | FROM CardBitOps IMPORT shl, ClearBit; 12 | 13 | 14 | (* --------------------------------------------------------------------------- 15 | * function: Hash.valueForNextChar( hash, ch ) 16 | * ------------------------------------------------------------------------ *) 17 | 18 | PROCEDURE valueForNextChar ( hash : Key; ch : CHAR ) : Key; 19 | 20 | BEGIN 21 | RETURN VAL(Key, ORD(ch)) + shl(hash, 6) + shl(hash, 16) - hash 22 | END valueForNextChar; 23 | 24 | 25 | (* --------------------------------------------------------------------------- 26 | * function: Hash.finalValue( hash ) 27 | * ------------------------------------------------------------------------ *) 28 | 29 | PROCEDURE finalValue ( hash : Key ) : Key; 30 | 31 | BEGIN 32 | (* Clear highest bit in hash value *) 33 | ClearBit(hash, Bitwidth-1); 34 | 35 | RETURN hash 36 | END finalValue; 37 | 38 | 39 | (* --------------------------------------------------------------------------- 40 | * function: Hash.valueForArray( array ) 41 | * ------------------------------------------------------------------------ *) 42 | 43 | PROCEDURE valueForArray ( VAR (* CONST *) array : ARRAY OF CHAR ) : Key; 44 | 45 | VAR 46 | ch : CHAR; 47 | hash : Key; 48 | index : CARDINAL; 49 | 50 | BEGIN 51 | index := 0; 52 | hash := initialValue; 53 | 54 | ch := array[index] 55 | WHILE (ch # ISO646.NUL) AND (index < HIGH(array)) DO 56 | hash := VAL(Key, (ORD(ch)) + shl(hash, 6) + shl(hash, 16) - hash; 57 | index := index + 1; 58 | ch := array[index] 59 | END; (* WHILE *) 60 | 61 | (* Clear highest bit in hash value *) 62 | ClearBit(hash, Bitwidth-1); 63 | 64 | RETURN hash 65 | END valueForArray; 66 | 67 | 68 | (* --------------------------------------------------------------------------- 69 | * module initialisation 70 | * ------------------------------------------------------------------------ *) 71 | 72 | BEGIN (* Hash *) 73 | (* assert that Key is 32-bit wide *) 74 | IF TSIZE(Key) # 32 THEN 75 | Console.WriteChars("Library Hash requires 32-bit CARDINAL."); 76 | Console.WriteLn; 77 | HALT 78 | END (* IF *) 79 | END Hash. -------------------------------------------------------------------------------- /src/lib/Hash/imp/Hash.LONGINT32.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | IMPLEMENTATION MODULE Hash; (* 32-bit LONGINT version *) 4 | 5 | (* General Purpose 32-bit Hash Function *) 6 | 7 | 8 | IMPORT ISO646, Console; 9 | 10 | FROM SYSTEM IMPORT TSIZE; 11 | FROM LongIntBitOps IMPORT shl, ClearBit; 12 | 13 | 14 | (* --------------------------------------------------------------------------- 15 | * function: Hash.valueForNextChar( hash, ch ) 16 | * ------------------------------------------------------------------------ *) 17 | 18 | PROCEDURE valueForNextChar ( hash : Key; ch : CHAR ) : Key; 19 | 20 | BEGIN 21 | RETURN VAL(Key, ORD(ch)) + shl(hash, 6) + shl(hash, 16) - hash 22 | END valueForNextChar; 23 | 24 | 25 | (* --------------------------------------------------------------------------- 26 | * function: Hash.finalValue( hash ) 27 | * ------------------------------------------------------------------------ *) 28 | 29 | PROCEDURE finalValue ( hash : Key ) : Key; 30 | 31 | BEGIN 32 | (* Clear highest bit in hash value *) 33 | ClearBit(hash, Bitwidth-1); 34 | 35 | RETURN hash 36 | END finalValue; 37 | 38 | 39 | (* --------------------------------------------------------------------------- 40 | * function: Hash.valueForArray( array ) 41 | * ------------------------------------------------------------------------ *) 42 | 43 | PROCEDURE valueForArray ( VAR (* CONST *) array : ARRAY OF CHAR ) : Key; 44 | 45 | VAR 46 | ch : CHAR; 47 | hash : Key; 48 | index : CARDINAL; 49 | 50 | BEGIN 51 | index := 0; 52 | hash := initialValue; 53 | 54 | ch := array[index] 55 | WHILE (ch # ISO646.NUL) AND (index < HIGH(array)) DO 56 | hash := VAL(Key, (ORD(ch)) + shl(hash, 6) + shl(hash, 16) - hash; 57 | index := index + 1; 58 | ch := array[index] 59 | END; (* WHILE *) 60 | 61 | (* Clear highest bit in hash value *) 62 | ClearBit(hash, Bitwidth-1); 63 | 64 | RETURN hash 65 | END valueForArray; 66 | 67 | 68 | (* --------------------------------------------------------------------------- 69 | * module initialisation 70 | * ------------------------------------------------------------------------ *) 71 | 72 | BEGIN (* Hash *) 73 | (* assert that Key is 32-bit wide *) 74 | IF TSIZE(Key) # 32 THEN 75 | Console.WriteChars("Library Hash requires 32-bit LONGINT."); 76 | Console.WriteLn; 77 | HALT 78 | END (* IF *) 79 | END Hash. -------------------------------------------------------------------------------- /src/lib/Hash/imp/LongHash.CARD64.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | IMPLEMENTATION MODULE LongHash; (* CARD64 version *) 4 | 5 | (* General Purpose 64-bit Hash Function *) 6 | 7 | 8 | IMPORT ISO646, CARD64, Console; 9 | 10 | FROM SYSTEM IMPORT TSIZE; 11 | 12 | 13 | (* --------------------------------------------------------------------------- 14 | * Initial value for incremental hash calculation 15 | * ------------------------------------------------------------------------ *) 16 | 17 | CONST initialValue = 0; 18 | 19 | 20 | (* --------------------------------------------------------------------------- 21 | * Procedure: LongHash.SetInitialValue( hash ) 22 | * ------------------------------------------------------------------------ *) 23 | 24 | PROCEDURE SetInitialValue ( VAR hash : Key ); 25 | 26 | BEGIN 27 | CARD64.FromCard(hash, initialValue) 28 | END SetInitialValue; 29 | 30 | 31 | (* --------------------------------------------------------------------------- 32 | * Procedure: LongHash.ValueForNextChar( hash, ch ) 33 | * ------------------------------------------------------------------------ *) 34 | 35 | PROCEDURE ValueForNextChar ( VAR hash : Key; ch : CHAR ); 36 | 37 | VAR 38 | n, result : Key; 39 | 40 | BEGIN 41 | (* hash := ORD(ch) + SHL(hash, 6) + SHL(hash, 16) - hash *) 42 | 43 | (* result := ORD(ch) *) 44 | CARD64.FromCard(result, ORD(ch)); 45 | 46 | (* result := result + SHL(hash, 6) *) 47 | n := hash; CARD64.Shl(n, 6); CARD64.Add(result, n); 48 | 49 | (* result := result + SHL(hash, 16) *) 50 | n := hash; CARD64.Shl(n, 16); CARD64.Add(result, n); 51 | 52 | (* result := result - hash *) 53 | CARD64.Sub(result, hash); 54 | 55 | hash := result 56 | END ValueForNextChar; 57 | 58 | 59 | (* --------------------------------------------------------------------------- 60 | * Procedure: LongHash.SetFinalValue( hash ) 61 | * ------------------------------------------------------------------------ *) 62 | 63 | PROCEDURE SetFinalValue ( VAR hash : Key ); 64 | 65 | BEGIN 66 | (* Clear highest bit in hash value *) 67 | CARD64.ClearBit(hash, Bitwidth-1) 68 | END finalValue; 69 | 70 | 71 | (* --------------------------------------------------------------------------- 72 | * Procedure: Hash.ValueForArray( hash, array ) 73 | * ------------------------------------------------------------------------ *) 74 | 75 | PROCEDURE ValueForArray 76 | ( VAR hash : Key; VAR (* CONST *) array : ARRAY OF CHAR ); 77 | 78 | VAR 79 | ch : CHAR; 80 | index : CARDINAL; 81 | n, newHash : Key; 82 | 83 | BEGIN 84 | index := 0; 85 | SetInitialValue(hash); 86 | 87 | ch := array[index] 88 | WHILE (ch # ISO646.NUL) AND (index < HIGH(array)) DO 89 | (* hash := ORD(ch) + SHL(hash, 6) + SHL(hash, 16) - hash *) 90 | 91 | (* newHash := ORD(ch) *) 92 | CARD64.FromCard(newHash, ORD(ch)); 93 | 94 | (* newHash := newHash + SHL(hash, 6) *) 95 | n := hash; CARD64.Shl(n, 6); CARD64.Add(newHash, n); 96 | 97 | (* newHash := newHash + SHL(hash, 16) *) 98 | n := hash; CARD64.Shl(n, 16); CARD64.Add(newHash, n); 99 | 100 | (* newHash := newHash - hash *) 101 | CARD64.Sub(newHash, hash); 102 | 103 | (* prepare for next iteration *) 104 | index := index + 1; 105 | ch := array[index]; 106 | hash := newHash 107 | END; (* WHILE *) 108 | 109 | (* Clear highest bit in hash value *) 110 | CARD64.ClearBit(hash, Bitwidth-1) 111 | END ValueForArray; 112 | 113 | 114 | (* --------------------------------------------------------------------------- 115 | * module initialisation 116 | * ------------------------------------------------------------------------ *) 117 | 118 | BEGIN (* LongHash *) 119 | (* assert that Key is 64-bit wide *) 120 | IF TSIZE(Key) # 64 THEN 121 | Console.WriteChars("Library LongHash requires CARD64."); 122 | Console.WriteLn; 123 | HALT 124 | END (* IF *) 125 | END LongHash. -------------------------------------------------------------------------------- /src/lib/Hash/imp/LongHash.LONGINT64.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | IMPLEMENTATION MODULE LongHash; (* 64-bit LONGINT version *) 4 | 5 | (* General Purpose 64-bit Hash Function *) 6 | 7 | 8 | IMPORT ISO646, Console; 9 | 10 | FROM SYSTEM IMPORT TSIZE; 11 | FROM LongIntBitOps IMPORT shl, ClearBit; 12 | 13 | 14 | (* --------------------------------------------------------------------------- 15 | * Initial value for incremental hash calculation 16 | * ------------------------------------------------------------------------ *) 17 | 18 | CONST initialValue = 0; 19 | 20 | 21 | (* --------------------------------------------------------------------------- 22 | * Procedure: LongHash.SetInitialValue( hash ) 23 | * ------------------------------------------------------------------------ *) 24 | 25 | PROCEDURE SetInitialValue ( VAR hash : Key ); 26 | 27 | BEGIN 28 | hash := initialValue 29 | END SetInitialValue; 30 | 31 | 32 | (* --------------------------------------------------------------------------- 33 | * Procedure: LongHash.ValueForNextChar( hash, ch ) 34 | * ------------------------------------------------------------------------ *) 35 | 36 | PROCEDURE ValueForNextChar ( VAR hash : Key; ch : CHAR ); 37 | 38 | BEGIN 39 | hash := VAL(Key, ORD(ch)) + shl(hash, 6) + shl(hash, 16) - hash 40 | END valueForNextChar; 41 | 42 | 43 | (* --------------------------------------------------------------------------- 44 | * Procedure: LongHash.SetFinalValue( hash ) 45 | * ------------------------------------------------------------------------ *) 46 | 47 | PROCEDURE SetFinalValue ( VAR hash : Key ); 48 | 49 | BEGIN 50 | (* Clear highest bit in hash value *) 51 | ClearBit(hash, Bitwidth-1) 52 | END finalValue; 53 | 54 | 55 | (* --------------------------------------------------------------------------- 56 | * Procedure: Hash.ValueForArray( hash, array ) 57 | * ------------------------------------------------------------------------ *) 58 | 59 | PROCEDURE ValueForArray 60 | ( VAR hash : Key; VAR (* CONST *) array : ARRAY OF CHAR ); 61 | 62 | VAR 63 | ch : CHAR; 64 | index : CARDINAL; 65 | 66 | BEGIN 67 | index := 0; 68 | hash := initialValue; 69 | 70 | ch := array[index] 71 | WHILE (ch # ISO646.NUL) AND (index < HIGH(array)) DO 72 | hash := VAL(Key, (ORD(ch)) + shl(hash, 6) + shl(hash, 16) - hash; 73 | index := index + 1; 74 | ch := array[index] 75 | END; (* WHILE *) 76 | 77 | (* Clear highest bit in hash value *) 78 | ClearBit(hash, Bitwidth-1) 79 | END valueForArray; 80 | 81 | 82 | (* --------------------------------------------------------------------------- 83 | * module initialisation 84 | * ------------------------------------------------------------------------ *) 85 | 86 | BEGIN (* LongHash *) 87 | (* assert that Key is 64-bit wide *) 88 | IF TSIZE(Key) # 64 THEN 89 | Console.WriteChars("Library LongHash requires 64-bit LONGINT."); 90 | Console.WriteLn; 91 | HALT 92 | END (* IF *) 93 | END LongHash. -------------------------------------------------------------------------------- /src/lib/IO/Console.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2016 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Console; 4 | 5 | (* Console output library *) 6 | 7 | FROM String IMPORT StringT; (* alias for String.String *) 8 | 9 | 10 | (* --------------------------------------------------------------------------- 11 | * procedure WriteChars(chars) 12 | * --------------------------------------------------------------------------- 13 | * Prints the given character array to the console. 14 | * ------------------------------------------------------------------------ *) 15 | 16 | PROCEDURE WriteChars ( chars : ARRAY OF CHAR ); 17 | 18 | 19 | (* --------------------------------------------------------------------------- 20 | * procedure WriteStr(s) 21 | * --------------------------------------------------------------------------- 22 | * Prints the given string to the console. 23 | * ------------------------------------------------------------------------ *) 24 | 25 | PROCEDURE WriteStr ( s : StringT ); 26 | 27 | 28 | (* --------------------------------------------------------------------------- 29 | * procedure WriteCharsAndStr(chars, s) 30 | * --------------------------------------------------------------------------- 31 | * Prints the given character array and string to the console. 32 | * ------------------------------------------------------------------------ *) 33 | 34 | PROCEDURE WriteCharsAndStr ( VAR chars : ARRAY OF CHAR; s : StringT ); 35 | 36 | 37 | (* --------------------------------------------------------------------------- 38 | * procedure WriteLn 39 | * --------------------------------------------------------------------------- 40 | * Prints newline to the console. 41 | * ------------------------------------------------------------------------ *) 42 | 43 | PROCEDURE WriteLn; 44 | 45 | 46 | (* --------------------------------------------------------------------------- 47 | * procedure WriteBool(value) 48 | * --------------------------------------------------------------------------- 49 | * Prints the given value to the console. "TRUE" for TRUE, "FALSE" for FALSE. 50 | * ------------------------------------------------------------------------ *) 51 | 52 | PROCEDURE WriteBool ( value : BOOLEAN ); 53 | 54 | 55 | (* --------------------------------------------------------------------------- 56 | * procedure WriteBoolCustom(value, trueStr, falseStr) 57 | * --------------------------------------------------------------------------- 58 | * Prints trueStr if value is TRUE, falseStr if value is FALSE. 59 | * ------------------------------------------------------------------------ *) 60 | 61 | PROCEDURE WriteBoolCustom 62 | ( value : BOOLEAN; VAR (* CONST *) trueStr, falseStr : ARRAY OF CHAR ); 63 | 64 | 65 | (* --------------------------------------------------------------------------- 66 | * procedure WriteChar(chars) 67 | * --------------------------------------------------------------------------- 68 | * Prints the given character to the console. 69 | * ------------------------------------------------------------------------ *) 70 | 71 | PROCEDURE WriteChar ( char : CHAR ); 72 | 73 | 74 | (* --------------------------------------------------------------------------- 75 | * procedure WriteCharU(chars) 76 | * --------------------------------------------------------------------------- 77 | * Prints the given character value in 0u notation to the console. 78 | * ------------------------------------------------------------------------ *) 79 | 80 | PROCEDURE WriteCharU ( char : CHAR ); 81 | 82 | 83 | (* --------------------------------------------------------------------------- 84 | * procedure WriteCard(value) 85 | * --------------------------------------------------------------------------- 86 | * Prints the given cardinal value to the console. 87 | * ------------------------------------------------------------------------ *) 88 | 89 | PROCEDURE WriteCard ( value : CARDINAL ); 90 | 91 | 92 | (* --------------------------------------------------------------------------- 93 | * procedure WriteCardX(chars) 94 | * --------------------------------------------------------------------------- 95 | * Prints the given cardinal value in 0x notation to the console. 96 | * ------------------------------------------------------------------------ *) 97 | 98 | PROCEDURE WriteCardX ( value : CARDINAL ); 99 | 100 | 101 | (* --------------------------------------------------------------------------- 102 | * procedure WriteInt(value) 103 | * --------------------------------------------------------------------------- 104 | * Prints the given integer value to the console. 105 | * ------------------------------------------------------------------------ *) 106 | 107 | PROCEDURE WriteInt ( value : INTEGER ); 108 | 109 | 110 | (* --------------------------------------------------------------------------- 111 | * procedure WriteIntX(value) 112 | * --------------------------------------------------------------------------- 113 | * Prints the given integer value in 0x notation to the console. 114 | * ------------------------------------------------------------------------ *) 115 | 116 | PROCEDURE WriteIntX ( value : INTEGER ); 117 | 118 | 119 | (* --------------------------------------------------------------------------- 120 | * procedure WriteLongInt(value) 121 | * --------------------------------------------------------------------------- 122 | * Prints the given long integer value to the console. 123 | * ------------------------------------------------------------------------ *) 124 | 125 | PROCEDURE WriteLongInt ( value : LONGINT ); 126 | 127 | 128 | (* --------------------------------------------------------------------------- 129 | * procedure WriteLongIntX(value) 130 | * --------------------------------------------------------------------------- 131 | * Prints the given long integer value in 0x notation to the console. 132 | * ------------------------------------------------------------------------ *) 133 | 134 | PROCEDURE WriteLongIntX ( value : LONGINT ); 135 | 136 | 137 | END Console. 138 | -------------------------------------------------------------------------------- /src/lib/IO/Consolidate/FileSystem.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE FileSystem; 4 | 5 | (* File System Access library for Modula-2 Bootstrap Kernel *) 6 | 7 | 8 | TYPE Access = ( Read, Write, Execute ); 9 | 10 | TYPE AccessFlags = SET OF Access; 11 | 12 | TYPE Permissions = RECORD 13 | owner, group, world : AccessFlags; 14 | END; 15 | 16 | TYPE Timestamp = RECORD 17 | year : CARDINAL [1970..9999]; 18 | month : CARDINAL [1..12]; 19 | day : CARDINAL [1..31]; 20 | hour : CARDINAL [0..23]; 21 | minute, 22 | second : CARDINAL [0..59]; 23 | millisec : CARDINAL [0..999] 24 | END; 25 | 26 | 27 | (* Operations *) 28 | 29 | PROCEDURE fileExists ( path : ARRAY OF CHAR ) : BOOLEAN; 30 | 31 | PROCEDURE isDirectory ( path : ARRAY OF CHAR ) : BOOLEAN; 32 | 33 | PROCEDURE GetFileSize 34 | ( path : ARRAY OF CHAR; VAR size : LONGINT; VAR s : Status ); 35 | 36 | PROCEDURE GetPermissions 37 | ( path : ARRAY OF CHAR; VAR p : Permissions; VAR s : Status ); 38 | 39 | PROCEDURE GetCreationTimeStamp 40 | ( path : ARRAY OF CHAR; VAR ts : Timestamp; VAR s : Status ); 41 | 42 | PROCEDURE GetModificationTimeStamp 43 | ( path : ARRAY OF CHAR; VAR ts : Timestamp; VAR s : Status ); 44 | 45 | PROCEDURE CreateFile ( path : ARRAY OF CHAR; VAR s : Status ); 46 | 47 | PROCEDURE RemoveFile ( path : ARRAY OF CHAR; VAR s : Status ); 48 | 49 | PROCEDURE CreateDir ( path : ARRAY OF CHAR; VAR s : Status ); 50 | 51 | PROCEDURE RemoveDir ( path : ARRAY OF CHAR; VAR s : Status ); 52 | 53 | 54 | END FileSystem. 55 | -------------------------------------------------------------------------------- /src/lib/IO/Consolidate/Fileutils.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Fileutils; 4 | 5 | (* File Utility Interface for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM UnsignedInt IMPORT ULONGINT; 8 | FROM String IMPORT StringT; 9 | 10 | 11 | (* -------------------------------------------------------------------------- 12 | * function fileExists(path) 13 | * -------------------------------------------------------------------------- 14 | * Returns TRUE if path is a valid pathname to an existing file system entry, 15 | * otherwise FALSE. 16 | * -------------------------------------------------------------------------- 17 | *) 18 | PROCEDURE fileExists ( path : ARRAY OF CHAR ) : BOOLEAN; 19 | 20 | 21 | (* -------------------------------------------------------------------------- 22 | * function isDirectory(path) 23 | * -------------------------------------------------------------------------- 24 | * Returns TRUE if path is a valid pathname to an existing directory, 25 | * otherwise FALSE. 26 | * -------------------------------------------------------------------------- 27 | *) 28 | PROCEDURE isDirectory ( path : ARRAY OF CHAR ) : BOOLEAN; 29 | 30 | 31 | (* -------------------------------------------------------------------------- 32 | * function isRegularFile(path) 33 | * -------------------------------------------------------------------------- 34 | * Returns TRUE if path is a valid pathname to an existing regular file, 35 | * otherwise FALSE. 36 | * -------------------------------------------------------------------------- 37 | *) 38 | PROCEDURE isRegularFile ( path : ARRAY OF CHAR ) : BOOLEAN; 39 | 40 | 41 | (* -------------------------------------------------------------------------- 42 | * procedure getFileSize(path, valid, size) 43 | * -------------------------------------------------------------------------- 44 | * Tests if path is a valid pathname indicating an existing regular file and 45 | * if so, passes TRUE in out-parameter valid and the file's size in out-para- 46 | * meter size. Otherwise it passes FALSE in out-parameter valid and leaves 47 | * out-parameter size unmodified. 48 | * -------------------------------------------------------------------------- 49 | *) 50 | PROCEDURE GetFileSize 51 | ( path : ARRAY OF CHAR; VAR valid : BOOLEAN; VAR size : ULONGINT ); 52 | 53 | 54 | (* -------------------------------------------------------------------------- 55 | * procedure GetFileTime(path, valid, time) 56 | * -------------------------------------------------------------------------- 57 | * Tests if path is a valid pathname indicating an existing regular file and 58 | * if so, it passes TRUE in out-parameter valid and the file's last modifica- 59 | * tion time to out-parameter time. Otherwise it passes FALSE in out-para- 60 | * meter valid and leaves out-parameter time unmodified. 61 | * -------------------------------------------------------------------------- 62 | *) 63 | PROCEDURE GetFileTime 64 | ( path : ARRAY OF CHAR; VAR valid : BOOLEAN; VAR time : LONGINT ); 65 | 66 | 67 | (* -------------------------------------------------------------------------- 68 | * procedure NewPathWithCurrentWorkdir(path) 69 | * -------------------------------------------------------------------------- 70 | * Returns a newly allocated NUL terminated character string containing the 71 | * absolute path of the current working directory. Returns NIL on failure. 72 | * -------------------------------------------------------------------------- 73 | *) 74 | PROCEDURE newPathWithCurrentWorkdir : StringT; 75 | 76 | 77 | END Fileutils. 78 | -------------------------------------------------------------------------------- /src/lib/IO/Consolidate/SimpleFileIO.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE SimpleFileIO; 4 | 5 | (* Simple File IO library for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM UnsignedInt IMPORT ULONGINT; 8 | 9 | 10 | TYPE File; (* OPAQUE *) 11 | 12 | TYPE Mode = ( Read, Write, Append ); 13 | 14 | TYPE Status = ( Success, Failure ); (* TO DO: refine *) 15 | 16 | 17 | (* Operations *) 18 | 19 | (* Support for an operation depends on the mode in which the file has 20 | * been opened. Any attempt to carry out an unsupported operation will 21 | * fail with status failure. 22 | * 23 | * operation supported in file mode 24 | * Read Write Append 25 | * ------------------------------------ 26 | * Open yes yes yes 27 | * Close yes yes yes 28 | * GetMode yes yes yes 29 | * GetStatus yes yes yes 30 | * GetPos yes yes no 31 | * SetPos yes no no 32 | * eof yes no no 33 | * ReadOctets yes no no 34 | * ReadChars yes no no 35 | * WriteOctets no yes yes 36 | * WriteChars no yes yes 37 | * ------------------------------------ 38 | *) 39 | 40 | 41 | (* Open and close *) 42 | 43 | PROCEDURE Open 44 | ( VAR f : File; filename : ARRAY OF CHAR; mode : Mode; VAR s : Status ); 45 | (* Opens file filename in mode. Passes file handle in f and status in s. 46 | If the file does not exist, it will be created when opened in write mode, 47 | otherwise status failure is passed back in s. When opening an already 48 | existing file in write mode, all of its current contents are replaced. *) 49 | 50 | PROCEDURE Close ( VAR f : File; s : Status ); 51 | (* Closes file associated with file handle f. Passes status in s. *) 52 | 53 | 54 | (* Introspection *) 55 | 56 | PROCEDURE GetMode ( f : File; VAR m : Mode ); 57 | (* Passes the mode of file f in m. *) 58 | 59 | PROCEDURE GetStatus ( f : File; VAR s : Status ); 60 | (* Passes the status of the last operation on file f in s. *) 61 | 62 | 63 | (* Positioning *) 64 | 65 | PROCEDURE GetPos ( f : File; VAR pos : ULONGINT ); 66 | (* Passes the current reading or writing position of file f in pos. *) 67 | 68 | PROCEDURE SetPos ( f : File; pos : ULONGINT ); 69 | (* Sets the reading position of file f to pos. *) 70 | 71 | PROCEDURE eof ( f : File ) : BOOLEAN; 72 | (* Returns TRUE if the end of file f has been reached, otherwise FALSE. *) 73 | 74 | 75 | (* IO operations *) 76 | 77 | PROCEDURE ReadOctets 78 | ( f : File; VAR buffer : ARRAY OF OCTET; VAR octetsRead : ULONGINT ); 79 | (* Reads contents starting at the current reading position of file f into 80 | buffer until either buffer is full or eof is reached. The number of octets 81 | actually read is passed in bytesRead. *) 82 | 83 | PROCEDURE ReadChars 84 | ( f : File; VAR buffer : ARRAY OF CHAR; VAR charsRead : ULONGINT ); 85 | (* Reads contents starting at the current reading position of file f into 86 | buffer until either the pen-ultimate index of buffer is written or eof 87 | is reached. The buffer is then terminated with ASCII NUL. The number of 88 | characters actually read is passed in charsRead. *) 89 | 90 | PROCEDURE WriteOctets 91 | ( f : File; buffer : ARRAY OF OCTET; VAR octetsWritten : ULONGINT ); 92 | (* Writes the contents of buffer at the current writing position to file f. 93 | The number of octets actually written is passed in bytesWritten. *) 94 | 95 | PROCEDURE WriteChars 96 | ( f : File; buffer : ARRAY OF CHAR; VAR charsWritten : ULONGINT ); 97 | (* Writes the contents of buffer up to and excluding the first ASCII NUL 98 | character code at the current writing position to file f. 99 | The number of characters actually written is passed in charsWritten. *) 100 | 101 | 102 | END SimpleFileIO. 103 | -------------------------------------------------------------------------------- /src/lib/IO/Consolidate/Source.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Source; 4 | 5 | (* Source File Reader for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM String IMPORT StringT; 8 | 9 | 10 | TYPE Source; (* OPAQUE *) 11 | 12 | TYPE SourceT = Source; (* for unqualified use *) 13 | 14 | 15 | TYPE Status = 16 | ( Success, 17 | InvalidReference, 18 | InvalidFileType, 19 | MaxFileSizeExceeded, 20 | AllocationFailed ); 21 | 22 | 23 | (* --------------------------------------------------------------------------- 24 | * Definitions 25 | * 26 | * start position : 27 | * the position of the first character in the source. 28 | * 29 | * end position : 30 | * the position of the last character in the source. 31 | * 32 | * lookahead position : 33 | * the position of the character to be consumed next. 34 | * 35 | * second lookahead position : 36 | * the position immediately following the lookahead position. 37 | * 38 | * marked position : 39 | * a position recorded as the start of a lexeme. 40 | * it is end position + 1 if no marker has been set. 41 | * 42 | * lookahead character : 43 | * the character at the lookahead position, 44 | * it is ASCII.NUL if its position > end position or if eof is set. 45 | * 46 | * second lookahead character : 47 | * the character at the second lookahead position, 48 | * it is ASCII.NUL if its position > end position or if eof is set. 49 | * 50 | * marked lexeme : 51 | * a character sequence that starts at the marked position (inclusively) 52 | * and ends at the lookahead position (exclusively). 53 | * 54 | * character consumption : 55 | * a character is consumed by advancing the lookahead position 56 | * to the character's second lookahead position or by setting eof. 57 | * 58 | * end-of-line marker: 59 | * an ASCII.LF, 60 | * or a sequence consisting of an ASCII.CR followed by an ASCII.LF, 61 | * or a sole ASCII.CR that is not immediately followed by ASCII.LF. 62 | * 63 | * The lookahead position of an end-of-line marker is the position 64 | * following the last character of the end-of-line marker. 65 | * 66 | * end-of-file flag: 67 | * abbreviated as eof flag, is a boolean value that is set when 68 | * the character at the end position has been consumed. 69 | * 70 | * --------------------------------------------------------------------------- 71 | *) 72 | 73 | 74 | (* Operations *) 75 | 76 | PROCEDURE New 77 | ( VAR s : Source; filename : StringT; VAR status : Status ); 78 | (* Passes back a newly allocated source instance associated with name in s. 79 | The associated file is opened for reading and the lookahead position is 80 | set to the start position. Passes back NIL in s if unsuccessful. 81 | The status of the operation is passed back in status. *) 82 | 83 | 84 | PROCEDURE GetChar ( s : Source; VAR ch, next : CHAR ); 85 | (* Passes back the lookahead character in ch and consumes it. 86 | Passes back the new lookahead character in next without consuming it. *) 87 | 88 | 89 | PROCEDURE consumeChar ( s : Source ) : CHAR; 90 | (* Consumes the current character of s, returns new lookahead character. *) 91 | 92 | 93 | PROCEDURE lookaheadChar ( s : Source ) : CHAR; 94 | (* Returns the lookahead character of s. 95 | Does not consume any character and does not set eof. *) 96 | 97 | 98 | PROCEDURE la2Char ( s : Source ) : CHAR; 99 | (* Returns the second lookahead character of s. 100 | Does not consume any character and does not set eof. *) 101 | 102 | 103 | PROCEDURE MarkLexeme ( s : Source; VAR line, col : CARDINAL ); 104 | (* Marks the lookahead position in s as the start of the marked lexeme. 105 | Passes back lookahead position line and column counters in line and col. *) 106 | 107 | 108 | PROCEDURE CopyLexeme ( s : Source; dict : LexDict; VAR handle : DictHandle ); 109 | (* Adds the marked lexeme in s to lexeme dictionary dict, passes its access 110 | handle back in handle and clears the lexeme marker. If no lexeme marker 111 | has been set, no content is copied and zero is passed back in handle. *) 112 | 113 | 114 | PROCEDURE GetLineAndColumn ( s : Source; VAR line, col : CARDINAL ); 115 | (* Passes back the current line and column counters of s in line and col. *) 116 | 117 | 118 | PROCEDURE eof ( s : Source ) : BOOLEAN; 119 | (* Returns TRUE if the last character in s has been consumed, else FALSE. *) 120 | 121 | 122 | PROCEDURE Release ( VAR s : Source; VAR status : Status ); 123 | (* Deallocates s. Passes back NIL in s if successful. 124 | The status of the operation is passed back in status. *) 125 | 126 | 127 | END Source. 128 | -------------------------------------------------------------------------------- /src/lib/IO/FilenameXlat.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE FilenameXlat; 4 | 5 | (* Filename translation interface for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM String IMPORT StringT; (* alias for String.String *) 8 | 9 | 10 | (* -------------------------------------------------------------------------- 11 | * Filename Translation 12 | * -------------------------------------------------------------------------- 13 | * Modula-2 module identifiers are used to derive the filenames for the 14 | * module's definition and implementation files. Since identifiers are case 15 | * sensitive in Modula-2 this can lead to ambiguities on case-insensitive 16 | * filesystems such as are used by default on MacOS and Windows operating 17 | * systems. Furthermore, module identifiers may be longer than the maximum 18 | * permitted filename length on filesystems with severely limited filename 19 | * lengths such as FAT16, used by default on MS-DOS and still in use on 20 | * modern USB storage devices. To provide a portable solution to this 21 | * problem, M2BSK uses a simple but effective filename translation system. 22 | * 23 | * A plain text file with filename translations and named M2FNDICT.TXT may 24 | * be placed in any directory in which Modula-2 source files are found. 25 | * M2BSK reads this dictionary file to determine whether any module 26 | * identifier needs to be translated to obtain its associated filename. 27 | * 28 | * At this time, dictionary files need to be edited by hand. 29 | * 30 | * The syntax of the dictionary file is as follows: 31 | * 32 | * dictionary := 33 | * translation ( ',' translation )* ';' 34 | * ; 35 | * 36 | * translation := 37 | * moduleIdent '=' actualBasename '.*' 38 | * ; 39 | * 40 | * moduleIdent := StdIdent; 41 | * 42 | * actualBasename := StdIdent ( '-' Digit Digit )? 43 | * 44 | * Space, tabulator and newline between symbols are ignored. 45 | * -------------------------------------------------------------------------- 46 | * Example dictionary for FAT32 and HFS+ filesystems: 47 | * 48 | * UNISTRING = Unistring-00.*, 49 | * UniString = Unistring-01.*; 50 | * -------------------------------------------------------------------------- 51 | * Example dictionary for FAT16 filesystem: 52 | * 53 | * COMPLEX = COMPL-00.*, 54 | * ComplexMath = COMPL-01.*; 55 | * ------------------------------------------------------------------------ *) 56 | 57 | 58 | (* Status type *) 59 | 60 | TYPE Status = 61 | ( Success, 62 | InvalidPath, 63 | InvalidFilename, 64 | InvalidReference, 65 | AllocationFailed ); 66 | 67 | 68 | (* Operations *) 69 | 70 | (* -------------------------------------------------------------------------- 71 | * function actualFilename(fullPath, status) 72 | * -------------------------------------------------------------------------- 73 | * Returns the actual filename for the file denoted by fullPath. 74 | * No filename translation takes place if no dictionary file is found in the 75 | * file's directory or no entry for the file exists in the dictionary file. 76 | * ------------------------------------------------------------------------ *) 77 | 78 | PROCEDURE actualFilename 79 | ( VAR (* CONST *) fullPath : ARRAY OF CHAR; VAR status : Status ) : StringT; 80 | 81 | 82 | (* -------------------------------------------------------------------------- 83 | * function actualFullPath(fullPath, status) 84 | * -------------------------------------------------------------------------- 85 | * Returns the actual full pathname for the file denoted by fullPath. 86 | * No filename translation takes place if no dictionary file is found in the 87 | * file's directory or no entry for the file exists in the dictionary file. 88 | * ------------------------------------------------------------------------ *) 89 | 90 | PROCEDURE actualFullPath 91 | ( VAR (* CONST *) fullPath : ARRAY OF CHAR; VAR status : Status ) : StringT; 92 | 93 | 94 | END FilenameXlat. 95 | -------------------------------------------------------------------------------- /src/lib/IO/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/lib/IO/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/lib/IO/Terminal.iso.def: -------------------------------------------------------------------------------- 1 | (*!m2iso*) (* Copyright (c) 2017 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Terminal; (* ISO Modula-2 only *) 4 | 5 | (* Shim Library to adapt ISO Modula-2's STextIO to PIM Modula-2's Terminal *) 6 | 7 | 8 | (* --------------------------------------------------------------------------- 9 | * procedure Read(ch) 10 | * --------------------------------------------------------------------------- 11 | * Blocking read operation. Reads a character from standard input. 12 | * ------------------------------------------------------------------------ *) 13 | 14 | PROCEDURE Read ( VAR ch : CHAR ); 15 | 16 | 17 | (* --------------------------------------------------------------------------- 18 | * procedure BusyRead(ch) 19 | * --------------------------------------------------------------------------- 20 | * Non-Blocking read operation. Reads a character from standard input, 21 | * returns ASCII.NUL if no character was available. 22 | * ------------------------------------------------------------------------ *) 23 | 24 | PROCEDURE BusyRead ( VAR ch : CHAR ); 25 | 26 | 27 | (* --------------------------------------------------------------------------- 28 | * procedure Write(ch) 29 | * --------------------------------------------------------------------------- 30 | * Writes the given character to standard output. 31 | * ------------------------------------------------------------------------ *) 32 | 33 | PROCEDURE Write ( ch : CHAR ); 34 | 35 | 36 | (* --------------------------------------------------------------------------- 37 | * procedure WriteString(array) 38 | * --------------------------------------------------------------------------- 39 | * Writes the given character array to standard output. 40 | * ------------------------------------------------------------------------ *) 41 | 42 | PROCEDURE WriteString ( VAR (* CONST *) array : ARRAY OF CHAR ); 43 | 44 | 45 | (* --------------------------------------------------------------------------- 46 | * procedure WriteLn 47 | * --------------------------------------------------------------------------- 48 | * Writes newline to standard output. 49 | * ------------------------------------------------------------------------ *) 50 | 51 | PROCEDURE WriteLn; 52 | 53 | 54 | END Terminal. 55 | -------------------------------------------------------------------------------- /src/lib/IO/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. 29 | -------------------------------------------------------------------------------- /src/lib/IO/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. 29 | -------------------------------------------------------------------------------- /src/lib/IO/imp/Terminal.duplicate.iso.mod: -------------------------------------------------------------------------------- 1 | (*!m2iso*) (* Copyright (c) 2017 B.Kowarsch. All rights reserved. *) 2 | 3 | IMPLEMENTATION MODULE Terminal; (* ISO Modula-2 only *) 4 | 5 | (* Shim Library to adapt ISO Modula-2's STextIO to PIM Modula-2's Terminal *) 6 | 7 | IMPORT STextIO; (* in ISO Modula-2's standard 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 BusyRead(ch) 25 | * --------------------------------------------------------------------------- 26 | * Non-Blocking read operation. Reads a character from standard input, 27 | * returns ASCII.NUL if no character was available. 28 | * ------------------------------------------------------------------------ *) 29 | 30 | PROCEDURE BusyRead ( VAR ch : CHAR ); 31 | 32 | BEGIN 33 | (* TO DO *) 34 | END BusyRead; 35 | 36 | 37 | (* --------------------------------------------------------------------------- 38 | * procedure Write(ch) 39 | * --------------------------------------------------------------------------- 40 | * Writes the given character to standard output. 41 | * ------------------------------------------------------------------------ *) 42 | 43 | PROCEDURE Write ( ch : CHAR ); 44 | 45 | BEGIN 46 | STextIO.WriteChar(ch) 47 | END 48 | 49 | 50 | (* --------------------------------------------------------------------------- 51 | * procedure WriteString(array) 52 | * --------------------------------------------------------------------------- 53 | * Writes the given character array to standard output. 54 | * ------------------------------------------------------------------------ *) 55 | 56 | PROCEDURE WriteString ( VAR (* CONST *) array : ARRAY OF CHAR ); 57 | 58 | BEGIN 59 | STextIO.WriteString(array) 60 | END WriteString; 61 | 62 | 63 | (* --------------------------------------------------------------------------- 64 | * procedure WriteLn 65 | * --------------------------------------------------------------------------- 66 | * Writes newline to standard output. 67 | * ------------------------------------------------------------------------ *) 68 | 69 | PROCEDURE WriteLn; 70 | 71 | BEGIN 72 | STextIO.WriteLn 73 | END WriteLn; 74 | 75 | 76 | END Terminal. 77 | -------------------------------------------------------------------------------- /src/lib/IO/imp/Terminal.iso.mod: -------------------------------------------------------------------------------- 1 | (*!m2iso*) (* Copyright (c) 2017 B.Kowarsch. All rights reserved. *) 2 | 3 | IMPLEMENTATION MODULE Terminal; (* ISO Modula-2 only *) 4 | 5 | (* Shim Library to adapt ISO Modula-2's STextIO to PIM Modula-2's Terminal *) 6 | 7 | IMPORT STextIO; (* in ISO Modula-2's standard 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 34 | 35 | 36 | (* --------------------------------------------------------------------------- 37 | * procedure WriteString(array) 38 | * --------------------------------------------------------------------------- 39 | * Writes the given character array to standard output. 40 | * ------------------------------------------------------------------------ *) 41 | 42 | PROCEDURE WriteString ( VAR (* CONST *) 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. 63 | -------------------------------------------------------------------------------- /src/lib/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. 106 | -------------------------------------------------------------------------------- /src/lib/IntBitOps.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE IntBitOps; (* portable *) 4 | 5 | (* Bit Operations on Type INTEGER *) 6 | 7 | 8 | CONST Bitwidth = TSIZE(INTEGER) * 8 - 1; 9 | 10 | TYPE BitIndex = CARDINAL [0..Bitwidth-1]; 11 | 12 | 13 | (* --------------------------------------------------------------------------- 14 | * function shl( i, shiftFactor ) 15 | * --------------------------------------------------------------------------- 16 | * Returns i shifted left by shiftFactor. 17 | * ------------------------------------------------------------------------ *) 18 | 19 | PROCEDURE shl ( i : INTEGER; shiftFactor : BitIndex ) : INTEGER; 20 | 21 | 22 | (* --------------------------------------------------------------------------- 23 | * function shr( i, shiftFactor ) 24 | * --------------------------------------------------------------------------- 25 | * Returns i logically shifted right by shiftFactor. 26 | * ------------------------------------------------------------------------ *) 27 | 28 | PROCEDURE shr ( i : INTEGER; shiftFactor : BitIndex ) : INTEGER; 29 | 30 | 31 | (* --------------------------------------------------------------------------- 32 | * function ashr( i, shiftFactor ) 33 | * --------------------------------------------------------------------------- 34 | * Returns i arithmetically shifted right by shiftFactor. 35 | * ------------------------------------------------------------------------ *) 36 | 37 | PROCEDURE ashr ( i : INTEGER; shiftFactor : BitIndex ) : INTEGER; 38 | 39 | 40 | (* --------------------------------------------------------------------------- 41 | * procedure SHLC( i, carryBits, bitIndex ) 42 | * --------------------------------------------------------------------------- 43 | * Left-shifts i by bitIndex and passes the shifted out bits in carryBits. 44 | * ------------------------------------------------------------------------ *) 45 | 46 | PROCEDURE SHLC ( VAR i, carryBits : INTEGER; bitIndex : BitIndex ); 47 | 48 | 49 | (* --------------------------------------------------------------------------- 50 | * function bit( i, bitIndex ) 51 | * --------------------------------------------------------------------------- 52 | * Returns TRUE if the bit at bitIndex of i is set, otherwise FALSE. 53 | * ------------------------------------------------------------------------ *) 54 | 55 | PROCEDURE bit ( i : INTEGER; bitIndex : BitIndex ) : INTEGER; 56 | 57 | 58 | (* --------------------------------------------------------------------------- 59 | * procedure SetBit( i, bitIndex ) 60 | * --------------------------------------------------------------------------- 61 | * Sets the bit at bitIndex of i. 62 | * ------------------------------------------------------------------------ *) 63 | 64 | PROCEDURE SetBit ( VAR i : INTEGER; bitIndex : BitIndex ); 65 | 66 | 67 | (* --------------------------------------------------------------------------- 68 | * procedure ClearBit( i, bitIndex ) 69 | * --------------------------------------------------------------------------- 70 | * Clears the bit at bitIndex of i. 71 | * ------------------------------------------------------------------------ *) 72 | 73 | PROCEDURE ClearBit ( VAR i : INTEGER; bitIndex : BitIndex ); 74 | 75 | 76 | (* --------------------------------------------------------------------------- 77 | * procedure ClearLSBtoN( i, bitIndex ) 78 | * --------------------------------------------------------------------------- 79 | * Clears the bits of i in range [0 .. bitIndex]. 80 | * ------------------------------------------------------------------------ *) 81 | 82 | PROCEDURE ClearLSBtoN ( VAR i : INTEGER; bitIndex : BitIndex ); 83 | 84 | 85 | (* --------------------------------------------------------------------------- 86 | * procedure ClearMSBtoN( i, bitIndex ) 87 | * --------------------------------------------------------------------------- 88 | * Clears the bits of i in range [bitIndex .. Bitwidth-1]. 89 | * ------------------------------------------------------------------------ *) 90 | 91 | PROCEDURE ClearMSBtoN ( VAR i : INTEGER; bitIndex : BitIndex ); 92 | 93 | 94 | END IntBitOps. -------------------------------------------------------------------------------- /src/lib/LongIntBitOps.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2020 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE LongIntBitOps; (* portable *) 4 | 5 | (* Bit Operations on Type LONGINT *) 6 | 7 | 8 | CONST Bitwidth = TSIZE(LONGINT) * 8 - 1; 9 | 10 | TYPE BitIndex = CARDINAL [0..Bitwidth-1]; 11 | 12 | 13 | (* --------------------------------------------------------------------------- 14 | * function shl( i, shiftFactor ) 15 | * --------------------------------------------------------------------------- 16 | * Returns i shifted left by shiftFactor. 17 | * ------------------------------------------------------------------------ *) 18 | 19 | PROCEDURE shl ( i : LONGINT; shiftFactor : BitIndex ) : LONGINT; 20 | 21 | 22 | (* --------------------------------------------------------------------------- 23 | * function shr( i, shiftFactor ) 24 | * --------------------------------------------------------------------------- 25 | * Returns i logically shifted right by shiftFactor. 26 | * ------------------------------------------------------------------------ *) 27 | 28 | PROCEDURE shr ( i : LONGINT; shiftFactor : BitIndex ) : LONGINT; 29 | 30 | 31 | (* --------------------------------------------------------------------------- 32 | * function ashr( i, shiftFactor ) 33 | * --------------------------------------------------------------------------- 34 | * Returns i arithmetically shifted right by shiftFactor. 35 | * ------------------------------------------------------------------------ *) 36 | 37 | PROCEDURE ashr ( i : LONGINT; shiftFactor : BitIndex ) : LONGINT; 38 | 39 | 40 | (* --------------------------------------------------------------------------- 41 | * procedure SHLC( i, carryBits, bitIndex ) 42 | * --------------------------------------------------------------------------- 43 | * Left-shifts i by bitIndex and passes the shifted out bits in carryBits. 44 | * ------------------------------------------------------------------------ *) 45 | 46 | PROCEDURE SHLC ( VAR i, carryBits : LONGINT; bitIndex : BitIndex ); 47 | 48 | 49 | (* --------------------------------------------------------------------------- 50 | * function bit( i, bitIndex ) 51 | * --------------------------------------------------------------------------- 52 | * Returns TRUE if the bit at bitIndex of i is set, otherwise FALSE. 53 | * ------------------------------------------------------------------------ *) 54 | 55 | PROCEDURE bit ( i : LONGINT; bitIndex : BitIndex ) : BOOLEAN; 56 | 57 | 58 | (* --------------------------------------------------------------------------- 59 | * procedure SetBit( i, bitIndex ) 60 | * --------------------------------------------------------------------------- 61 | * Sets the bit at bitIndex of i. 62 | * ------------------------------------------------------------------------ *) 63 | 64 | PROCEDURE SetBit ( VAR i : LONGINT; bitIndex : BitIndex ); 65 | 66 | 67 | (* --------------------------------------------------------------------------- 68 | * procedure ClearBit( i, bitIndex ) 69 | * --------------------------------------------------------------------------- 70 | * Clears the bit at bitIndex of i. 71 | * ------------------------------------------------------------------------ *) 72 | 73 | PROCEDURE ClearBit ( VAR i : LONGINT; bitIndex : BitIndex ); 74 | 75 | 76 | (* --------------------------------------------------------------------------- 77 | * procedure ClearLSBtoN( i, bitIndex ) 78 | * --------------------------------------------------------------------------- 79 | * Clears the bits of i in range [0 .. bitIndex]. 80 | * ------------------------------------------------------------------------ *) 81 | 82 | PROCEDURE ClearLSBtoN ( VAR i : LONGINT; bitIndex : BitIndex ); 83 | 84 | 85 | (* --------------------------------------------------------------------------- 86 | * procedure ClearMSBtoN( i, bitIndex ) 87 | * --------------------------------------------------------------------------- 88 | * Clears the bits of i in range [bitIndex .. Bitwidth-1]. 89 | * ------------------------------------------------------------------------ *) 90 | 91 | PROCEDURE ClearMSBtoN ( VAR i : LONGINT; bitIndex : BitIndex ); 92 | 93 | 94 | END LongIntBitOps. -------------------------------------------------------------------------------- /src/lib/Octet.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2024 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Octet; 4 | 5 | 6 | TYPE Octet = CARDINAL [0 .. 255]; 7 | 8 | TYPE OctetT = Octet; (* for unqualified use *) 9 | 10 | 11 | END Octet. -------------------------------------------------------------------------------- /src/lib/Pathnames/Pathname.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE Pathname; 4 | 5 | (* Pathname Parser Interface for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | FROM String IMPORT StringT; (* alias for String.String *) 8 | 9 | 10 | (* Pathname type *) 11 | 12 | TYPE Pathname; (* OPAQUE *) 13 | 14 | TYPE PathnameT = Pathname; (* for unqualified use *) 15 | 16 | 17 | (* Filetypes *) 18 | 19 | TYPE SuffixType = 20 | ( NoSuffix, (* no suffix *) 21 | DefSuffix, (* .def or .DEF *) 22 | ModSuffix, (* .mod or .MOD *) 23 | SymSuffix, (* .sym or .SYM *) 24 | AstSuffix, (* .ast or .AST *) 25 | DotSuffix, (* .dot or .DOT *) 26 | ObjSuffix, (* .obj or .OBJ *) 27 | OtherSuffix ); (* any others *) 28 | 29 | 30 | (* Status type *) 31 | 32 | TYPE Status = 33 | ( Success, 34 | InvalidPath, 35 | InvalidFilename, 36 | InvalidReference, 37 | AllocationFailed ); 38 | 39 | 40 | (* Operations *) 41 | 42 | (* -------------------------------------------------------------------------- 43 | * procedure NewFromOSPath(path, osPath, status) 44 | * -------------------------------------------------------------------------- 45 | * Creates a new pathname object, initialised from the path in osPath. 46 | * ------------------------------------------------------------------------ *) 47 | 48 | PROCEDURE NewFromOSPath 49 | ( VAR path : Pathname; osPath : ARRAY OF CHAR; VAR status : Status ); 50 | 51 | 52 | (* -------------------------------------------------------------------------- 53 | * procedure newFromComponents(path, dirpath, basename, suffix, status) 54 | * -------------------------------------------------------------------------- 55 | * Creates a new pathname object from the given component strings. 56 | * ------------------------------------------------------------------------ *) 57 | 58 | PROCEDURE newFromComponents 59 | ( VAR path : Pathname; 60 | dirpath, basename, suffix : StringT; VAR status : Status ); 61 | 62 | 63 | (* -------------------------------------------------------------------------- 64 | * function fullPath(path) 65 | * -------------------------------------------------------------------------- 66 | * Returns a string with the full pathname of path. 67 | * ------------------------------------------------------------------------ *) 68 | 69 | PROCEDURE fullPath ( path : Pathname ) : StringT; 70 | 71 | 72 | (* -------------------------------------------------------------------------- 73 | * function dirPath(path) 74 | * -------------------------------------------------------------------------- 75 | * Returns a string with the dirpath of path. 76 | * ------------------------------------------------------------------------ *) 77 | 78 | PROCEDURE dirPath ( path : Pathname ) : StringT; 79 | 80 | 81 | (* -------------------------------------------------------------------------- 82 | * function filename(path) 83 | * -------------------------------------------------------------------------- 84 | * Returns a string with the filename of path. 85 | * ------------------------------------------------------------------------ *) 86 | 87 | PROCEDURE filename ( path : Pathname ) : StringT; 88 | 89 | 90 | (* -------------------------------------------------------------------------- 91 | * function basename(path) 92 | * -------------------------------------------------------------------------- 93 | * Returns a string with the basename of path. 94 | * ------------------------------------------------------------------------ *) 95 | 96 | PROCEDURE basename ( path : Pathname ) : StringT; 97 | 98 | 99 | (* -------------------------------------------------------------------------- 100 | * function suffix(path) 101 | * -------------------------------------------------------------------------- 102 | * Returns a string with the suffix of path. 103 | * ------------------------------------------------------------------------ *) 104 | 105 | PROCEDURE suffix ( path : Pathname ) : StringT; 106 | 107 | 108 | (* -------------------------------------------------------------------------- 109 | * function suffixType(path) 110 | * -------------------------------------------------------------------------- 111 | * Returns the suffix type of path. 112 | * ------------------------------------------------------------------------ *) 113 | 114 | PROCEDURE suffixType ( path : Pathname ) : SuffixType; 115 | 116 | 117 | (* -------------------------------------------------------------------------- 118 | * procedure Release(path) 119 | * -------------------------------------------------------------------------- 120 | * Releases the path object and sets path to nil. 121 | * ------------------------------------------------------------------------ *) 122 | 123 | PROCEDURE Release ( VAR path : Pathname ); 124 | 125 | 126 | (* Operations on character arrays *) 127 | 128 | (* -------------------------------------------------------------------------- 129 | * function isValidOSPath(osPath) 130 | * -------------------------------------------------------------------------- 131 | * Returns TRUE if osPath is a valid pathname, otherwise FALSE. 132 | * ------------------------------------------------------------------------ *) 133 | 134 | PROCEDURE isValidOSPath ( osPath : ARRAY OF CHAR ) : BOOLEAN; 135 | 136 | 137 | (* -------------------------------------------------------------------------- 138 | * function isValidFilename(filename) 139 | * -------------------------------------------------------------------------- 140 | * Returns TRUE if filename is a valid filename, otherwise FALSE. 141 | * ------------------------------------------------------------------------ *) 142 | 143 | PROCEDURE isValidFilename ( filename : ARRAY OF CHAR ) : BOOLEAN; 144 | 145 | 146 | END Pathname. 147 | -------------------------------------------------------------------------------- /src/lib/Pathnames/PathnamePolicy.amigaos.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE PathnamePolicy; (* AmigaOS version *) 4 | 5 | (* Pathname policy parameters *) 6 | 7 | (* -------------------------------------------------------------------------- 8 | * All settings are applied at compile time and cannot be changed at runtime! 9 | * ----------------------------------------------------------------------- *) 10 | 11 | (* -------------------------------------------------------------------------- 12 | * Use of special characters in pathname components 13 | * -------------------------------------------------------------------------- 14 | * The following constants define whether certain special characters may or 15 | * may not occur legally within a pathname component: 16 | * 17 | * PathCompMayContainPeriod 18 | * enables or disables the use of period ('.') in a pathname component. 19 | * 20 | * Restrictions 21 | * - a period may not be trailing nor consecutive, 22 | * 23 | * PathCompMayContainSpace 24 | * enables or disables the use of space (' ') in a pathname component. 25 | * 26 | * Restrictions 27 | * - a space may not be leading nor trailing nor consecutive, 28 | * 29 | * PathCompMayContainMinus 30 | * enables or disables the use of minus ('-') in a pathname component. 31 | * 32 | * Restrictions 33 | * - a minus may not be leading. 34 | * 35 | * PathCompMayContainTilde 36 | * enables or disables the use of tilde ('~') in a pathname component. 37 | * 38 | * Restrictions 39 | * - a tilde may not be leading. 40 | * ----------------------------------------------------------------------- *) 41 | 42 | 43 | CONST 44 | PathCompMayContainPeriod = TRUE; (* enabled *) 45 | PathCompMayContainSpace = TRUE; (* enabled *) 46 | PathCompMayContainMinus = TRUE; (* enabled *) 47 | PathCompMayContainTilde = FALSE; (* disabled *) 48 | 49 | 50 | END PathnamePolicy. 51 | -------------------------------------------------------------------------------- /src/lib/Pathnames/PathnamePolicy.default.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE PathnamePolicy; (* Default version *) 4 | 5 | (* Pathname policy parameters *) 6 | 7 | (* -------------------------------------------------------------------------- 8 | * All settings are applied at compile time and cannot be changed at runtime! 9 | * ----------------------------------------------------------------------- *) 10 | 11 | (* -------------------------------------------------------------------------- 12 | * Use of special characters in pathname components 13 | * -------------------------------------------------------------------------- 14 | * The following constants define whether certain special characters may or 15 | * may not occur legally within a pathname component: 16 | * 17 | * PathCompMayContainPeriod 18 | * enables or disables the use of period ('.') in a pathname component. 19 | * 20 | * Restrictions 21 | * - a period may not be trailing nor consecutive, 22 | * 23 | * PathCompMayContainSpace 24 | * enables or disables the use of space (' ') in a pathname component. 25 | * 26 | * Restrictions 27 | * - a space may not be leading nor trailing nor consecutive, 28 | * 29 | * PathCompMayContainMinus 30 | * enables or disables the use of minus ('-') in a pathname component. 31 | * 32 | * Restrictions 33 | * - a minus may not be leading. 34 | * 35 | * PathCompMayContainTilde 36 | * enables or disables the use of tilde ('~') in a pathname component. 37 | * 38 | * Restrictions 39 | * - a tilde may not be leading. 40 | * ----------------------------------------------------------------------- *) 41 | 42 | 43 | CONST 44 | PathCompMayContainPeriod = FALSE; (* disabled *) 45 | PathCompMayContainSpace = FALSE; (* disabled *) 46 | PathCompMayContainMinus = TRUE; (* enabled *) 47 | PathCompMayContainTilde = FALSE; (* disabled *) 48 | 49 | 50 | END PathnamePolicy. 51 | -------------------------------------------------------------------------------- /src/lib/Pathnames/PathnamePolicy.macos.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE PathnamePolicy; (* MacOS version *) 4 | 5 | (* Pathname policy parameters *) 6 | 7 | (* -------------------------------------------------------------------------- 8 | * All settings are applied at compile time and cannot be changed at runtime! 9 | * ----------------------------------------------------------------------- *) 10 | 11 | (* -------------------------------------------------------------------------- 12 | * Use of special characters in pathname components 13 | * -------------------------------------------------------------------------- 14 | * The following constants define whether certain special characters may or 15 | * may not occur legally within a pathname component: 16 | * 17 | * PathCompMayContainPeriod 18 | * enables or disables the use of period ('.') in a pathname component. 19 | * 20 | * Restrictions 21 | * - a period may not be trailing nor consecutive, 22 | * 23 | * PathCompMayContainSpace 24 | * enables or disables the use of space (' ') in a pathname component. 25 | * 26 | * Restrictions 27 | * - a space may not be leading nor trailing nor consecutive, 28 | * 29 | * PathCompMayContainMinus 30 | * enables or disables the use of minus ('-') in a pathname component. 31 | * 32 | * Restrictions 33 | * - a minus may not be leading. 34 | * 35 | * PathCompMayContainTilde 36 | * enables or disables the use of tilde ('~') in a pathname component. 37 | * 38 | * Restrictions 39 | * - a tilde may not be leading. 40 | * ----------------------------------------------------------------------- *) 41 | 42 | 43 | CONST 44 | PathCompMayContainPeriod = TRUE; (* enabled *) 45 | PathCompMayContainSpace = TRUE; (* enabled *) 46 | PathCompMayContainMinus = TRUE; (* enabled *) 47 | PathCompMayContainTilde = FALSE; (* disabled *) 48 | 49 | 50 | END PathnamePolicy. 51 | -------------------------------------------------------------------------------- /src/lib/Pathnames/PathnamePolicy.msdos.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE PathnamePolicy; (* MS-DOS version *) 4 | 5 | (* Pathname policy parameters *) 6 | 7 | (* -------------------------------------------------------------------------- 8 | * All settings are applied at compile time and cannot be changed at runtime! 9 | * ----------------------------------------------------------------------- *) 10 | 11 | (* -------------------------------------------------------------------------- 12 | * Use of special characters in pathname components 13 | * -------------------------------------------------------------------------- 14 | * The following constants define whether certain special characters may or 15 | * may not occur legally within a pathname component: 16 | * 17 | * PathCompMayContainPeriod 18 | * enables or disables the use of period ('.') in a pathname component. 19 | * 20 | * Restrictions 21 | * - a period may not be trailing nor consecutive, 22 | * 23 | * PathCompMayContainSpace 24 | * enables or disables the use of space (' ') in a pathname component. 25 | * 26 | * Restrictions 27 | * - a space may not be leading nor trailing nor consecutive, 28 | * 29 | * PathCompMayContainMinus 30 | * enables or disables the use of minus ('-') in a pathname component. 31 | * 32 | * Restrictions 33 | * - a minus may not be leading. 34 | * 35 | * PathCompMayContainTilde 36 | * enables or disables the use of tilde ('~') in a pathname component. 37 | * 38 | * Restrictions 39 | * - a tilde may not be leading. 40 | * ----------------------------------------------------------------------- *) 41 | 42 | 43 | CONST 44 | PathCompMayContainPeriod = FALSE; (* disabled *) 45 | PathCompMayContainSpace = FALSE; (* disabled *) 46 | PathCompMayContainMinus = TRUE; (* enabled *) 47 | PathCompMayContainTilde = TRUE; (* enabled *) 48 | 49 | 50 | END PathnamePolicy. 51 | -------------------------------------------------------------------------------- /src/lib/Pathnames/PathnamePolicy.openvms.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE PathnamePolicy; (* VMS/OpenVMS version *) 4 | 5 | (* Pathname policy parameters *) 6 | 7 | (* -------------------------------------------------------------------------- 8 | * All settings are applied at compile time and cannot be changed at runtime! 9 | * ----------------------------------------------------------------------- *) 10 | 11 | (* -------------------------------------------------------------------------- 12 | * Use of special characters in pathname components 13 | * -------------------------------------------------------------------------- 14 | * The following constants define whether certain special characters may or 15 | * may not occur legally within a pathname component: 16 | * 17 | * PathCompMayContainPeriod 18 | * enables or disables the use of period ('.') in a pathname component. 19 | * 20 | * Restrictions 21 | * - a period may not be trailing nor consecutive, 22 | * - a period must be escaped with a caret ('^') on OpenVMS. 23 | * 24 | * PathCompMayContainSpace 25 | * enables or disables the use of space (' ') in a pathname component. 26 | * 27 | * Restrictions 28 | * - a space may not be leading nor trailing nor consecutive, 29 | * - a space must be escaped with a caret ('^') on OpenVMS. 30 | * 31 | * PathCompMayContainMinus 32 | * enables or disables the use of minus ('-') in a pathname component. 33 | * 34 | * Restrictions 35 | * - a minus may not be leading. 36 | * 37 | * PathCompMayContainTilde 38 | * enables or disables the use of tilde ('~') in a pathname component. 39 | * 40 | * Restrictions 41 | * - a tilde may not be leading. 42 | * ----------------------------------------------------------------------- *) 43 | 44 | 45 | CONST 46 | PathCompMayContainPeriod = FALSE; (* disabled *) 47 | PathCompMayContainSpace = FALSE; (* disabled *) 48 | PathCompMayContainMinus = TRUE; (* enabled *) 49 | PathCompMayContainTilde = TRUE; (* enabled *) 50 | 51 | 52 | END PathnamePolicy. 53 | -------------------------------------------------------------------------------- /src/lib/Pathnames/PathnamePolicy.os2.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE PathnamePolicy; (* OS/2 version *) 4 | 5 | (* Pathname policy parameters *) 6 | 7 | (* -------------------------------------------------------------------------- 8 | * All settings are applied at compile time and cannot be changed at runtime! 9 | * ----------------------------------------------------------------------- *) 10 | 11 | (* -------------------------------------------------------------------------- 12 | * Use of special characters in pathname components 13 | * -------------------------------------------------------------------------- 14 | * The following constants define whether certain special characters may or 15 | * may not occur legally within a pathname component: 16 | * 17 | * PathCompMayContainPeriod 18 | * enables or disables the use of period ('.') in a pathname component. 19 | * 20 | * Restrictions 21 | * - a period may not be trailing nor consecutive, 22 | * 23 | * PathCompMayContainSpace 24 | * enables or disables the use of space (' ') in a pathname component. 25 | * 26 | * Restrictions 27 | * - a space may not be leading nor trailing nor consecutive, 28 | * 29 | * PathCompMayContainMinus 30 | * enables or disables the use of minus ('-') in a pathname component. 31 | * 32 | * Restrictions 33 | * - a minus may not be leading. 34 | * 35 | * PathCompMayContainTilde 36 | * enables or disables the use of tilde ('~') in a pathname component. 37 | * 38 | * Restrictions 39 | * - a tilde may not be leading. 40 | * ----------------------------------------------------------------------- *) 41 | 42 | 43 | CONST 44 | PathCompMayContainPeriod = FALSE; (* disabled *) 45 | PathCompMayContainSpace = FALSE; (* disabled *) 46 | PathCompMayContainMinus = TRUE; (* enabled *) 47 | PathCompMayContainTilde = TRUE; (* enabled *) 48 | 49 | 50 | END PathnamePolicy. 51 | -------------------------------------------------------------------------------- /src/lib/Pathnames/PathnamePolicy.posix.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE PathnamePolicy; (* POSIX/Unix version *) 4 | 5 | (* Pathname policy parameters *) 6 | 7 | (* -------------------------------------------------------------------------- 8 | * All settings are applied at compile time and cannot be changed at runtime! 9 | * ----------------------------------------------------------------------- *) 10 | 11 | (* -------------------------------------------------------------------------- 12 | * Use of special characters in pathname components 13 | * -------------------------------------------------------------------------- 14 | * The following constants define whether certain special characters may or 15 | * may not occur legally within a pathname component: 16 | * 17 | * PathCompMayContainPeriod 18 | * enables or disables the use of period ('.') in a pathname component. 19 | * 20 | * Restrictions 21 | * - a period may not be trailing nor consecutive, 22 | * 23 | * PathCompMayContainSpace 24 | * enables or disables the use of space (' ') in a pathname component. 25 | * 26 | * Restrictions 27 | * - a space may not be leading nor trailing nor consecutive, 28 | * 29 | * PathCompMayContainMinus 30 | * enables or disables the use of minus ('-') in a pathname component. 31 | * 32 | * Restrictions 33 | * - a minus may not be leading. 34 | * 35 | * PathCompMayContainTilde 36 | * enables or disables the use of tilde ('~') in a pathname component. 37 | * 38 | * Restrictions 39 | * - a tilde may not be leading. 40 | * ----------------------------------------------------------------------- *) 41 | 42 | 43 | CONST 44 | PathCompMayContainPeriod = TRUE; (* enabled *) 45 | PathCompMayContainSpace = FALSE; (* disabled *) 46 | PathCompMayContainMinus = TRUE; (* enabled *) 47 | PathCompMayContainTilde = FALSE; (* disabled *) 48 | 49 | 50 | END PathnamePolicy. 51 | -------------------------------------------------------------------------------- /src/lib/Pathnames/PathnamePolicy.windows.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2015 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE PathnamePolicy; (* Microsoft Windows version *) 4 | 5 | (* Pathname policy parameters *) 6 | 7 | (* -------------------------------------------------------------------------- 8 | * All settings are applied at compile time and cannot be changed at runtime! 9 | * ----------------------------------------------------------------------- *) 10 | 11 | (* -------------------------------------------------------------------------- 12 | * Use of special characters in pathname components 13 | * -------------------------------------------------------------------------- 14 | * The following constants define whether certain special characters may or 15 | * may not occur legally within a pathname component: 16 | * 17 | * PathCompMayContainPeriod 18 | * enables or disables the use of period ('.') in a pathname component. 19 | * 20 | * Restrictions 21 | * - a period may not be trailing nor consecutive, 22 | * 23 | * PathCompMayContainSpace 24 | * enables or disables the use of space (' ') in a pathname component. 25 | * 26 | * Restrictions 27 | * - a space may not be leading nor trailing nor consecutive, 28 | * 29 | * PathCompMayContainMinus 30 | * enables or disables the use of minus ('-') in a pathname component. 31 | * 32 | * Restrictions 33 | * - a minus may not be leading. 34 | * 35 | * PathCompMayContainTilde 36 | * enables or disables the use of tilde ('~') in a pathname component. 37 | * 38 | * Restrictions 39 | * - a tilde may not be leading. 40 | * ----------------------------------------------------------------------- *) 41 | 42 | 43 | CONST 44 | PathCompMayContainPeriod = FALSE; (* disabled *) 45 | PathCompMayContainSpace = TRUE; (* enabled *) 46 | PathCompMayContainMinus = TRUE; (* enabled *) 47 | PathCompMayContainTilde = TRUE; (* enabled *) 48 | 49 | 50 | END PathnamePolicy. 51 | -------------------------------------------------------------------------------- /src/lib/Pathnames/README.md: -------------------------------------------------------------------------------- 1 | ### Pathnames ### 2 | 3 | for pathname syntax see https://github.com/m2sf/m2sharp/wiki/Pathname-Diagrams 4 | -------------------------------------------------------------------------------- /src/lib/String.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE String; 4 | 5 | (* Interned Strings *) 6 | 7 | 8 | (* String Type *) 9 | 10 | TYPE String; (* OPAQUE *) 11 | 12 | TYPE StringT = String; (* for unqualified use *) 13 | 14 | 15 | (* Maximum String Length *) 16 | 17 | CONST MaxStringLength = 4096; 18 | 19 | 20 | (* Procedure type for passing to procedure WithCharsDo *) 21 | 22 | TYPE CharArrayProc = PROCEDURE ( ARRAY OF CHAR ); 23 | 24 | 25 | (* Procedure type for passing to procedure WithCharsInSliceDo *) 26 | 27 | TYPE CharProc = PROCEDURE ( CHAR ); 28 | 29 | 30 | (* Operations *) 31 | 32 | PROCEDURE forArray ( VAR (* CONST *) array : ARRAY OF CHAR) : String; 33 | (* Looks up the interned string for the given character array and returns it. 34 | Creates and returns a new interned string if no matching entry is found. *) 35 | 36 | 37 | PROCEDURE forArraySlice 38 | ( VAR (* CONST *) array : ARRAY OF CHAR; start, end : CARDINAL) : String; 39 | (* Looks up the interned string for the given slice of the given character 40 | array and returns it. Creates and returns a new interned string with the 41 | slice if no matching entry is found. *) 42 | 43 | 44 | PROCEDURE forSlice ( string : String; start, end : CARDINAL ) : String; 45 | (* Looks up the interned string for the given slice of the given string 46 | and returns it. Creates and returns a new interned string with the 47 | slice if no matching entry is found. *) 48 | 49 | 50 | PROCEDURE forConcatenation ( string1, string2 : String ) : String; 51 | (* Looks up the product of concatenating string1 and string2 and returns the 52 | matching interned string if an entry exists. Creates and returns a new 53 | interned string with the concatenation product if no match is found. *) 54 | 55 | 56 | PROCEDURE length ( string : String ) : CARDINAL; 57 | (* Returns the length of the given string. Returns 0 if string is NIL. *) 58 | 59 | 60 | PROCEDURE charAtIndex ( string : String; index : CARDINAL ) : CHAR; 61 | (* Returns the character at the given index in the given string. 62 | Returns ASCII.NUL if string is NIL or if index is out of range. *) 63 | 64 | 65 | PROCEDURE CopyToArray 66 | ( string : String; VAR array : ARRAY OF CHAR; VAR charsCopied : CARDINAL ); 67 | (* Copies the given string to the given array reference. Returns without copy- 68 | ing if string is NIL or if the array size is insufficient to hold the 69 | entire string. Passes the number of characters copied in charsCopied. *) 70 | 71 | 72 | PROCEDURE CopySliceToArray 73 | ( string : String; 74 | start, end : CARDINAL; 75 | VAR array : ARRAY OF CHAR; 76 | VAR charsCopied : CARDINAL ); 77 | (* Copies the given slice of the given string to the given array. Returns 78 | without copying if string is NIL, if start and end do not specify a valid 79 | slice within the string or if the array size is insufficient to hold the 80 | entire slice. Passes the number of characters copied in charsCopied. *) 81 | 82 | 83 | PROCEDURE matchesArray 84 | ( string : String; VAR (* CONST *) array : ARRAY OF CHAR ) : BOOLEAN; 85 | (* Returns TRUE if the given string matches the given array. Returns FALSE 86 | if string is NIL or if string does not match the array. *) 87 | 88 | 89 | PROCEDURE matchesArraySlice 90 | ( string : String; 91 | VAR (* CONST *) array : ARRAY OF CHAR; 92 | start, end : CARDINAL ) : BOOLEAN; 93 | (* Returns TRUE if the given string matches the given slice of the given 94 | array. Returns FALSE if string is NIL or if start and end do not specify 95 | a valid slice within the array. *) 96 | 97 | 98 | PROCEDURE WithCharsDo ( string : String; proc : CharArrayProc ); 99 | (* Executes proc passing the character array of string. *) 100 | 101 | 102 | PROCEDURE WithCharsInSliceDo 103 | ( string : String; start, end : CARDINAL; proc : CharProc ); 104 | (* Executes proc for each character in the given slice of string 105 | passing each character from start to end. *) 106 | 107 | 108 | (* Introspection *) 109 | 110 | PROCEDURE count () : CARDINAL; 111 | (* Returns the number of interned strings. *) 112 | 113 | 114 | END String. 115 | -------------------------------------------------------------------------------- /src/lib/String.gen.def: -------------------------------------------------------------------------------- 1 | (*!m2##ver##*) (* Copyright (c) 2017 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE String; (* ##VER## version *) 4 | 5 | (* Interned Strings *) 6 | 7 | (*?iso*)FROM SYSTEM IMPORT CAST;(*?;*) 8 | 9 | 10 | (* String Type *) 11 | 12 | TYPE String; (* OPAQUE *) 13 | 14 | TYPE StringT = String; (* for unqualified use *) 15 | 16 | 17 | (* NIL String *) 18 | 19 | CONST Nil = (*?pim*)NIL(*?iso*)CAST(StringT, NIL)(*?;*); 20 | 21 | 22 | (* Maximum String Length *) 23 | 24 | CONST MaxStringLength = 4096; 25 | 26 | 27 | (* Procedure type for passing to procedure WithCharsDo *) 28 | 29 | TYPE CharArrayProc = PROCEDURE ( ARRAY OF CHAR ); 30 | 31 | 32 | (* Procedure type for passing to procedure WithCharsInSliceDo *) 33 | 34 | TYPE CharProc = PROCEDURE ( CHAR ); 35 | 36 | 37 | (* Operations *) 38 | 39 | PROCEDURE forArray ( VAR (* CONST *) array : ARRAY OF CHAR) : StringT; 40 | (* Looks up the interned string for the given character array and returns it. 41 | Creates and returns a new interned string if no matching entry is found. *) 42 | 43 | 44 | PROCEDURE forArraySlice 45 | ( VAR (* CONST *) array : ARRAY OF CHAR; start, end : CARDINAL) : StringT; 46 | (* Looks up the interned string for the given slice of the given character 47 | array and returns it. Creates and returns a new interned string with the 48 | slice if no matching entry is found. *) 49 | 50 | 51 | PROCEDURE forSlice ( string : StringT; start, end : CARDINAL ) : StringT; 52 | (* Looks up the interned string for the given slice of the given string 53 | and returns it. Creates and returns a new interned string with the 54 | slice if no matching entry is found. *) 55 | 56 | 57 | PROCEDURE forConcatenation ( string1, string2 : StringT ) : StringT; 58 | (* Looks up the product of concatenating string1 and string2 and returns the 59 | matching interned string if an entry exists. Creates and returns a new 60 | interned string with the concatenation product if no match is found. *) 61 | 62 | 63 | PROCEDURE length ( string : StringT ) : CARDINAL; 64 | (* Returns the length of the given string. Returns 0 if string is NIL. *) 65 | 66 | 67 | PROCEDURE charAtIndex ( string : StringT; index : CARDINAL ) : CHAR; 68 | (* Returns the character at the given index in the given string. 69 | Returns ASCII.NUL if string is NIL or if index is out of range. *) 70 | 71 | 72 | PROCEDURE CopyToArray 73 | ( string : StringT; VAR array : ARRAY OF CHAR; VAR charsCopied : CARDINAL ); 74 | (* Copies the given string to the given array reference. Returns without copy- 75 | ing if string is NIL or if the array size is insufficient to hold the 76 | entire string. Passes the number of characters copied in charsCopied. *) 77 | 78 | 79 | PROCEDURE CopySliceToArray 80 | ( string : StringT; 81 | start, end : CARDINAL; 82 | VAR array : ARRAY OF CHAR; 83 | VAR charsCopied : CARDINAL ); 84 | (* Copies the given slice of the given string to the given array. Returns 85 | without copying if string is NIL, if start and end do not specify a valid 86 | slice within the string or if the array size is insufficient to hold the 87 | entire slice. Passes the number of characters copied in charsCopied. *) 88 | 89 | 90 | PROCEDURE matchesArray 91 | ( string : StringT; VAR (* CONST *) array : ARRAY OF CHAR ) : BOOLEAN; 92 | (* Returns TRUE if the given string matches the given array. Returns FALSE 93 | if string is NIL or if string does not match the array. *) 94 | 95 | 96 | PROCEDURE matchesArraySlice 97 | ( string : StringT; 98 | VAR (* CONST *) array : ARRAY OF CHAR; 99 | start, end : CARDINAL ) : BOOLEAN; 100 | (* Returns TRUE if the given string matches the given slice of the given 101 | array. Returns FALSE if string is NIL or if start and end do not specify 102 | a valid slice within the array. *) 103 | 104 | 105 | PROCEDURE WithCharsDo ( string : String; proc : CharArrayProc ); 106 | (* Executes proc passing the character array of string. *) 107 | 108 | 109 | PROCEDURE WithCharsInSliceDo 110 | ( string : StringT; start, end : CARDINAL; proc : CharProc ); 111 | (* Executes proc for each character in the given slice of string 112 | passing each character from start to end. *) 113 | 114 | 115 | (* Introspection *) 116 | 117 | PROCEDURE count () : CARDINAL; 118 | (* Returns the number of interned strings. *) 119 | 120 | 121 | END String. 122 | -------------------------------------------------------------------------------- /src/lib/UnsignedInt.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 B.Kowarsch. All rights reserved. *) 2 | 3 | DEFINITION MODULE UnsignedInt; 4 | 5 | (* PIM compliant Unsigned Integers for Modula-2 R10 Bootstrap Kernel *) 6 | 7 | 8 | CONST 9 | MaxInteger = MAX(INTEGER); 10 | MaxLongInt = MAX(LONGINT); 11 | 12 | 13 | TYPE 14 | UINTEGER = INTEGER [0..MaxInteger]; 15 | ULONGINT = LONGINT [0..MaxLongInt]; 16 | 17 | 18 | END UnsignedInt. 19 | -------------------------------------------------------------------------------- /src/lib/imp/Char.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2017 Modula-2 Software Foundation *) 2 | 3 | IMPLEMENTATION MODULE Char; 4 | 5 | (* Character tests and conversions *) 6 | 7 | IMPORT ISO646; 8 | 9 | 10 | (* Tests *) 11 | 12 | PROCEDURE isControl ( ch : CHAR ) : BOOLEAN; 13 | (* Returns TRUE if ch is a control code, otherwise FALSE. *) 14 | 15 | BEGIN 16 | RETURN (ch <= ISO646.US) OR (ch = ISO646.DEL) 17 | END isControl; 18 | 19 | 20 | PROCEDURE isDigit ( ch : CHAR ) : BOOLEAN; 21 | (* Returns TRUE if ch is a digit, otherwise FALSE. *) 22 | 23 | BEGIN 24 | RETURN (ch >= '0') AND (ch <= '9') 25 | END isDigit; 26 | 27 | 28 | PROCEDURE isAtoF ( ch : CHAR ) : BOOLEAN; 29 | (* Returns TRUE if ch is a base-16 digit, otherwise FALSE. *) 30 | 31 | BEGIN 32 | RETURN (ch >= 'A') AND (ch <= 'F') 33 | END isAtoF; 34 | 35 | 36 | PROCEDURE isLetter ( ch : CHAR ) : BOOLEAN; 37 | (* Returns TRUE if ch is a letter, otherwise FALSE. *) 38 | 39 | BEGIN 40 | RETURN ((ch >= 'A') AND (ch <= 'Z')) OR ((ch >= 'a') AND (ch <= 'z')) 41 | END isLetter; 42 | 43 | 44 | PROCEDURE isUpper ( ch : CHAR ) : BOOLEAN; 45 | (* Returns TRUE if ch is an uppercase letter, otherwise FALSE. *) 46 | 47 | BEGIN 48 | RETURN (ch >= 'A') AND (ch <= 'Z') 49 | END isUpper; 50 | 51 | 52 | PROCEDURE isLower ( ch : CHAR ) : BOOLEAN; 53 | (* Returns TRUE if ch is a lowercase letter, otherwise FALSE. *) 54 | 55 | BEGIN 56 | RETURN (ch >= 'a') AND (ch <= 'z') 57 | END isLower; 58 | 59 | 60 | PROCEDURE isAlphaNum ( ch : CHAR ) : BOOLEAN; 61 | (* Returns TRUE if ch is alpha-numeric, otherwise FALSE. *) 62 | 63 | BEGIN 64 | RETURN 65 | ((ch >= '0') AND (ch <= '9')) OR 66 | ((ch >= 'A') AND (ch <= 'Z')) OR 67 | ((ch >= 'a') AND (ch <= 'z')) 68 | END isAlphaNum; 69 | 70 | 71 | PROCEDURE isPrintable ( ch : CHAR ) : BOOLEAN; 72 | (* Returns TRUE if ch is printable, otherwise FALSE. *) 73 | 74 | BEGIN 75 | RETURN (ch >= ISO646.SP) AND (ch <= '~') 76 | END isPrintable; 77 | 78 | 79 | PROCEDURE isQuotable ( ch : CHAR ) : BOOLEAN; 80 | (* Returns TRUE if ch is quotable, otherwise FALSE. *) 81 | 82 | BEGIN 83 | RETURN 84 | (ch = ISO646.SP) OR 85 | ((ch >= '(') AND (ch <= '[')) OR 86 | ((ch >= ']') AND (ch <= '~')) OR 87 | ((ch >= 'a') AND (ch <= 'z')) OR 88 | ((ch >= '#') AND (ch <= '&')) OR (ch = '!') 89 | END isQuotable; 90 | 91 | 92 | PROCEDURE isEscapable ( ch : CHAR ) : BOOLEAN; 93 | (* Returns TRUE if ch is escapable, otherwise FALSE. *) 94 | 95 | BEGIN 96 | RETURN (ch = ISO646.BACKSLASH) OR (ch = 'n') OR (ch = 't') 97 | END isEscapable; 98 | 99 | 100 | (* Conversions *) 101 | 102 | PROCEDURE toUpper ( ch : CHAR ) : CHAR; 103 | (* Returns the uppercase equivalent of ch if ch is a lowercase letter. 104 | Otherwise returns ch. *) 105 | 106 | BEGIN 107 | IF (ch >= 'a') AND (ch <= 'z') THEN 108 | RETURN CHR(ORD(ch) - 32) 109 | ELSE (* not lowercase *) 110 | RETURN ch 111 | END (* IF *) 112 | END toUpper; 113 | 114 | 115 | PROCEDURE ToUpper ( VAR ch : CHAR ); 116 | (* Replaces ch with its uppercase equivalent if ch is a lowercase letter. *) 117 | 118 | BEGIN 119 | IF (ch >= 'a') AND (ch <= 'z') THEN ch := CHR(ORD(ch) - 32) END 120 | END ToUpper; 121 | 122 | 123 | PROCEDURE toLower ( ch : CHAR ) : CHAR; 124 | (* Returns the lowercase equivalent of ch if ch is an uppercase letter. 125 | Otherwise returns ch. *) 126 | 127 | BEGIN 128 | IF (ch >= 'A') AND (ch <= 'Z') THEN 129 | RETURN CHR(ORD(ch) + 32) 130 | ELSE (* not uppercase *) 131 | RETURN ch 132 | END (* IF *) 133 | END toLower; 134 | 135 | 136 | PROCEDURE ToLower ( VAR ch : CHAR ); 137 | (* Replaces ch with its lowercase equivalent if ch is a uppercase letter. *) 138 | 139 | BEGIN 140 | IF (ch >= 'A') AND (ch <= 'Z') THEN ch := CHR(ORD(ch) + 32) END 141 | END ToLower; 142 | 143 | 144 | END Char. 145 | -------------------------------------------------------------------------------- /src/lib/unicode/Unichar.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2024 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Unichar; 4 | 5 | (* Portable UNICHAR Type *) 6 | 7 | 8 | FROM Unichar0 IMPORT UnicharBaseT; 9 | 10 | 11 | (* Highest Code Point *) 12 | 13 | CONST MaxCodePoint = 1114111; 14 | 15 | 16 | (* UNICHAR Type *) 17 | 18 | TYPE UNICHAR = UnicharBaseT [0 .. MaxCodePoint]; 19 | 20 | 21 | 22 | (* --------------------------------------------------------------------------- 23 | * function UCHR( value ) 24 | * --------------------------------------------------------------------------- 25 | * Returns the UNICHAR code point for value. 26 | * ------------------------------------------------------------------------ *) 27 | 28 | PROCEDURE UCHR ( val : UnicharBaseT ) : UNICHAR; 29 | 30 | 31 | END Unichar. -------------------------------------------------------------------------------- /src/lib/unicode/Unichar.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2024 Modula-2 Software Foundation. *) 2 | 3 | IMPLEMENTATION MODULE Unichar; (* portable *) 4 | 5 | 6 | 7 | (* --------------------------------------------------------------------------- 8 | * function UCHR( value ) 9 | * --------------------------------------------------------------------------- 10 | * Returns the UNICHAR code point for value. 11 | * ------------------------------------------------------------------------ *) 12 | 13 | PROCEDURE UCHR ( val : UnicharBaseT ) : UNICHAR; 14 | 15 | BEGIN 16 | IF (value > MaxCodePoint) OR (value < 0) THEN 17 | HALT 18 | END; (* IF *) 19 | 20 | RETURN VAL(UNICHAR, value) 21 | END UCHR; 22 | 23 | 24 | END Unichar. -------------------------------------------------------------------------------- /src/lib/unicode/Unichar0.cardinal32.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2024 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Unichar0; (* CARDINAL version *) 4 | 5 | (* For use on targets where CARDINAL is 32-bit wide. *) 6 | 7 | 8 | 9 | (* Unichar Base Type *) 10 | 11 | TYPE UnicharBaseT = CARDINAL; 12 | 13 | 14 | END Unichar0. -------------------------------------------------------------------------------- /src/lib/unicode/Unichar0.longint32.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2024 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Unichar0; (* LONGINT version *) 4 | 5 | (* For use on targets where LONGINT is 32-bit wide, but CARDINAL is not. *) 6 | 7 | 8 | (* Unichar Base Type *) 9 | 10 | TYPE UnicharBaseT = LONGINT; 11 | 12 | 13 | END Unichar0. -------------------------------------------------------------------------------- /src/lib/unicode/Utf8.def: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2024 Modula-2 Software Foundation. *) 2 | 3 | DEFINITION MODULE Utf8; 4 | 5 | (* Portable UTF8 Type *) 6 | 7 | 8 | FROM Octet IMPORT OctetT; 9 | FROM Unichar IMPORT UNICHAR; 10 | 11 | 12 | 13 | (* Maximum UTF8 Length *) 14 | 15 | CONST MaxUTF8Length = 4; (* RFC 3629 *) 16 | 17 | 18 | (* UTF8 Type *) 19 | 20 | TYPE UTF8 = RECORD 21 | length : CARDINAL; 22 | octet : ARRAY [0 .. MaxUTF8Length-1] OF OctetT 23 | END; (* UTF8 *) 24 | 25 | 26 | (* --------------------------------------------------------------------------- 27 | * function decode( utf8 ) 28 | * --------------------------------------------------------------------------- 29 | * Decodes a UTF8 octet sequence and returns the corresponding UNICHAR value 30 | * ------------------------------------------------------------------------ *) 31 | 32 | PROCEDURE decode ( VAR (* CONST *) utf8 : UTF8 ) : UNICHAR; 33 | 34 | 35 | (* --------------------------------------------------------------------------- 36 | * procedure Encode( cp, utf8 ) 37 | * --------------------------------------------------------------------------- 38 | * Encodes a UNICHAR value, passes back the corresponding UTF8 octet sequence 39 | * ------------------------------------------------------------------------ *) 40 | 41 | PROCEDURE Encode ( cp : UNICHAR; VAR utf8 : UTF8 ); 42 | 43 | 44 | END Utf8. -------------------------------------------------------------------------------- /src/lib/unicode/Utf8.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim*) (* Copyright (c) 2024 Modula-2 Software Foundation. *) 2 | 3 | IMPLEMENTATION MODULE Utf8; (* portable *) 4 | 5 | 6 | (* --------------------------------------------------------------------------- 7 | * function decode( utf8 ) 8 | * --------------------------------------------------------------------------- 9 | * Decodes a UTF8 octet sequence and returns the corresponding UNICHAR value 10 | * ------------------------------------------------------------------------ *) 11 | 12 | PROCEDURE decode ( VAR (* CONST *) utf8 : UTF8 ) : UNICHAR; 13 | 14 | VAR cp : UNICHAR; 15 | 16 | BEGIN 17 | CASE utf8.length OF 18 | 1 : 19 | cp := VAL(UNICHAR, utf8[0]) 20 | 21 | | 2 : 22 | cp := 23 | 256 * (VAL(UNICHAR, utf8[0]) MOD 32) 24 | + VAL(UNICHAR, utf8[1]) MOD 64 25 | | 3 : 26 | cp := 27 | 65536 * (VAL(UNICHAR, utf8[0]) MOD 16) 28 | + 256 * (VAL(UNICHAR, utf8[1]) MOD 64) 29 | + VAL(UNICHAR, utf8[2]) MOD 64 30 | 31 | | 4 : 32 | cp := 33 | 16777216 * (VAL(UNICHAR, utf8[0]) MOD 8) 34 | + 65536 * (VAL(UNICHAR, utf8[1]) MOD 64) 35 | + 256 * (VAL(UNICHAR, utf8[2]) MOD 64) 36 | + VAL(UNICHAR, utf8[3]) MOD 64 37 | 38 | ELSE (* invalid *) 39 | cp := 0; 40 | (* TO DO: error handling *) 41 | END; (* CASE *) 42 | 43 | RETURN cp 44 | END decode; 45 | 46 | 47 | (* --------------------------------------------------------------------------- 48 | * procedure Encode( cp, utf8 ) 49 | * --------------------------------------------------------------------------- 50 | * Encodes a UNICHAR value, passes back the corresponding UTF8 octet sequence 51 | * ------------------------------------------------------------------------ *) 52 | 53 | PROCEDURE Encode ( cp : UNICHAR; VAR utf8 : UTF8 ); 54 | 55 | VAR index : CARDINAL; 56 | 57 | BEGIN 58 | CASE cp OF 59 | (* code point in range U+0000 .. U+007F *) 60 | 0 .. 127 : 61 | utf8.length := 1; 62 | utf8.octet[0] := VAL(Octet, cp); 63 | 64 | (* code point in range U+0080 .. U+07FF *) 65 | | 128 .. 2047 : 66 | utf8.length := 2; 67 | 68 | (* 1st octet = (cp SHR 6) MOD 64 + prefix 0xC0 *) 69 | utf8.octet[0] := VAL(Octet, (cp DIV 64) MOD 64) + 192; 70 | 71 | (* 2nd octet = cp MOD 64 + prefix 0x80 *) 72 | utf8.octet[2] := VAL(Octet, cp MOD 64) + 128 73 | 74 | (* code point in range U+0800 .. U+FFFF *) 75 | | 2048 .. 65535 : 76 | utf8.length := 3; 77 | 78 | (* 1st octet = (cp SHR 12) MOD 16 + prefix 0xE0 *) 79 | utf8.octet[0] := VAL(Octet, (cp DIV 4096) MOD 16) + 224; 80 | 81 | (* 2nd octet = (cp SHR 6) MOD 64 + prefix 0x80 *) 82 | utf8.octet[1] := VAL(Octet, (cp DIV 4096) MOD 64) + 128; 83 | 84 | (* 3rd octet = cp MOD 64 + prefix 0x80 *) 85 | utf8.octet[2] := VAL(Octet, cp MOD 64) + 128 86 | 87 | (* code point in range U+010000 .. U+10FFFF *) 88 | | 65536 .. 1114111 : 89 | utf8.length := 4; 90 | 91 | (* 1st octet = (cp SHR 18) MOD 8 + prefix 0xF0 *) 92 | utf8.octet[0] := VAL(Octet, (cp DIV 262144) MOD 8) + 240; 93 | 94 | (* 2nd octet = (cp SHR 12) MOD 64 + prefix 0x80 *) 95 | utf8.octet[1] := VAL(Octet, (cp DIV 4096) MOD 64) + 128; 96 | 97 | (* 3rd octet = (cp SHR 6) MOD 64 + prefix 0x80 *) 98 | utf8.octet[2] := VAL(Octet, (cp DIV 64) MOD 64) + 128; 99 | 100 | (* 4th octet = cp MOD 64 + prefix 0x80 *) 101 | utf8.octet[3] := VAL(Octet, cp MOD 64) + 128 102 | 103 | (* code point out of valid range for RFC 3629 *) 104 | ELSE (* overlong *) 105 | utf8.length := 0 106 | (* TO DO: error handling *) 107 | END; (* CASE *) 108 | 109 | (* clear unused octets *) 110 | FOR index := utf8.length TO MaxUTF8Length-1 DO 111 | utf8.octet[index] := 0 112 | END (* FOR *) 113 | END Encode; 114 | 115 | 116 | END Utf8. -------------------------------------------------------------------------------- /xeq/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 M2BSK reads its command line arguments from a file called `m2bskargs.tmp`. 7 | A small launch script is therefore required that will echo the command line arguments into 8 | this file, then launch M2BSK and delete the temporary file again after M2BSK has exited. 9 | 10 | This directory will contain the launch scripts for different operating systems: 11 | 12 | * `mc.sh` for the bash shell used on Unix and Unix-like operating systems 13 | * `mc.bat` for the command interpreter on Windows, MS-DOS and OS/2 14 | * `mc.com` for the DCL command language on OpenVMS 15 | 16 | A launch script for AmigaOS shall be added in the future. 17 | --------------------------------------------------------------------------------