├── .gitignore ├── Makefile ├── README.md ├── doc └── OMake.md ├── omake.ini ├── script └── build-omake.sh ├── src ├── aria │ ├── arArgs.ob2 │ ├── arC.ob2 │ ├── arCFormat.ob2 │ ├── arCString.ob2 │ ├── arChar.ob2 │ ├── arConfiguration.ob2 │ ├── arDir.ob2 │ ├── arErr.ob2 │ ├── arFile.ob2 │ ├── arFormat.ob2 │ ├── arJSON.ob2 │ ├── arMath.ob2 │ ├── arOut.ob2 │ ├── arPath.ob2 │ ├── arPattern.ob2 │ ├── arSize.ob2 │ ├── arStream.ob2 │ ├── arStringAssoc.ob2 │ ├── arStringList.ob2 │ ├── arStrings.ob2 │ ├── arText.ob2 │ └── arValue.ob2 ├── lib │ ├── libCK.ob2 │ ├── libCairo.ob2 │ ├── libPortAudio.ob2 │ ├── libPortMidi.ob2 │ └── libSDL.ob2 └── tool │ ├── OEF.ob2 │ └── OMake.ob2 └── test ├── HeapDebug.ob2 ├── HeapGrind.ob2 ├── TestAll.ob2 ├── TestDir.ob2 ├── TestJSON.Mod ├── TestPath.ob2 ├── TestStrings.ob2 ├── TestValue.ob2 └── Tests.ob2 /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | tmp 3 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | OBJS=TestAll OMake OEF 2 | 3 | all: tools test 4 | 5 | tools: OMake 6 | ./OMake OMake 7 | ./OMake OEF 8 | 9 | clean: 10 | rm -f *.c *.sym *.oh 11 | rm -rf *.dSYM 12 | 13 | clean-all: clean 14 | rm -f $(OBJS) 15 | 16 | test: TestAll 17 | ./TestAll 18 | 19 | TestAll: OMake 20 | ./OMake TestAll 21 | 22 | # boostrap OMake 23 | OMake: script/build-omake.sh 24 | script/build-omake.sh 25 | 26 | bootstrap: 27 | ./OMake -script OMake > script/build-omake.sh 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # aria 2 | 3 | A collection of Oberon-2 modules and tools for Ofront compilers. 4 | 5 | ## Tools 6 | 7 | * `OEF` - Ofront Error Filter. This small program takes error messages output by the compiler and converts to a human-readable format. 8 | * `OMake` - [Oberon Make tool](doc/OMake.md). **OMake** is a tool for automating the process of building large Oberon-2 projects. **OMake** uses only the dependency information already expressed in the Oberon-2 source, and requires no additional scripts in order to compile and link projects. 9 | 10 | ### Installation 11 | 12 | 1. Set the variable `OFRONT` to point to your OfrontPlus installation 13 | 2. Set the variable `TARGET` to your build target (eg. macOS) 14 | 3. In the top directory: `make` 15 | 16 | This should run a bootstrap script to build `OMake`, which is then used to build other targets: `OEF`, and `TestAll`. 17 | 18 | Configuration for `OMake` is in `omake.ini`. This might need to be adjusted if special C compiler options are required. 19 | 20 | ## Modules 21 | 22 | These are some basic utility modules I am using for my own projects. The overall philosophy is to build on functionality that is already in libc. 23 | 24 | ### Text 25 | 26 | Most Oberon systems have a particular way of handling text, based on the mutable documents. This is great if you want a text editor, but sometimes its an overkill for simple things. 27 | 28 | `arText` provides a basic interface for writing Oberon primitive types as text, similar to `Out`, or `Console` in the standard library. `arText.Writer` has procedures for writing Char, String, Integer, Hex, Real, Boolean, Set, and Ln. `Writer` can be used to: 29 | 30 | - Construct strings 31 | - Output text to streams (stdout, stderr) 32 | - Output text to files 33 | 34 | `arText.Writer` is built on a simpler interface `arText.Stream` which basically just outputs Char and String. `arText.Writer` uses libc to convert Integer, Real, and Hex to text, and default conversions can be specified using `printf` style formats. 35 | 36 | `arText.Buffer` is a mutable text string that can be built incrementally using the `Writer` interface. Text.Buffers are often instantiated statically as local variables, and are used for quickly constructing strings (like a Java StringBuffer). 37 | 38 | `arStream` implements text streams for libc `FILE` objects: stdout, stderr, and files. 39 | 40 | ### Data Types 41 | 42 | `arStrings` is a module for basic string operations, based on `ooc2Strings` but with some additional functions. 43 | 44 | `arValue` is A set of abstract data types. This is useful for defining data resources for programs. Oberon lacks any structured constants, which can make it painful to define constant data. Types implemented here can be read directly from JSON strings or files, and can also be serialised to JSON text. 45 | 46 | Boxed types for Oberon scalars: 47 | 48 | * Set 49 | * Boolean 50 | * Real 51 | * Integer 52 | * String (backed by POINTER TO ARRAY OF CHAR) 53 | 54 | Collection types: 55 | 56 | * List, a variable length linked list 57 | * Record, similar to a Javascript/JSON object 58 | * Array, fixed length tuples, backed by POINTER TO ARRAY OF Object 59 | 60 | Object base type supports: 61 | 62 | * Equals - test for equality 63 | * Copy and DeepCopy 64 | * Convert to String 65 | * Read structured object from JSON string 66 | * Write structured object to text or JSON 67 | 68 | `arJSON` is a JSON parser. `arJSON.ReadFile` reads a file and returns an `arValue.Object`. `arJSON.ParseString` parses a string and returns an `arValue.Object`. Thus JSON objects can be stored in external files, or converted directly from string literals within the program. 69 | 70 | ### Other utilities 71 | 72 | `arConfiguration` implements a basic system for parsing command-line options, and configuration files. 73 | 74 | `arSize` defines 2-argument minimum / maximum functions which are missing from Oberon-2, but implemented in Component Pascal. 75 | 76 | `arMath` contains code procedures for `math.h` functions. 77 | 78 | `arPath` contains functions for manipulating file and directory names, paths, and extensions. 79 | 80 | `arFormat` attempts some basic formatting in the spirit of printf. Oberon doesn't have have variable argument lists, so there are families of function for specific numbers of parameters. Arguments are of type `arValue.Object`, so primitive types must be boxed like so: 81 | 82 | F.Out3("{} plus {} equals {}\n", V.int(x), V.int(y), V.int(x+y)); 83 | 84 | Use `OutN` to print a formatted string with N parameters. The corresponding `FormatN` functions return a formatted `arValue.String`. For example: 85 | 86 | text := F.Format2("Moved to position ({}, {})", V.real(x), V.real(y)); 87 | 88 | For Real and Integer, standard printf Formatting options are supported. Don't include the '%' as this is added automatically. For example: 89 | 90 | F.Out3("MIDI: {02x} {02x} {02x}\n", V.int(status), V.int(data1), V.int(data2)); 91 | 92 | 93 | ## Libraries 94 | 95 | `src/lib` contains bindings for a few of my favourite C libraries. Most of these are minimal bindings written by hand, with Ofront-style code procedures. Included are: 96 | 97 | * libPortAudio 98 | * libPortMidi 99 | * libSDL 100 | * libCairo 101 | 102 | -------------------------------------------------------------------------------- /doc/OMake.md: -------------------------------------------------------------------------------- 1 | # OMake - A build tool for Ofront+ 2 | 3 | **OMake** is a tool for automatically building large Oberon-2 projects. 4 | 5 | **OMake** uses only the dependency information already expressed in the Oberon-2 source, and requires no extra scripts to compile and link projects. 6 | 7 | To build any Oberon-2 module: 8 | 9 | ``` 10 | OMake Module 11 | ``` 12 | 13 | **OMake** locates the source code for `Module` (eg. `Module.ob2`) and parses the `IMPORT` statements to identify all the imported modules. If an imported module is part of a library, that library is added as a link dependency. Otherwise, each imported module is recursively pre-built from each of its dependencies. 14 | 15 | **OMake** uses **OFront+** to compile each Oberon source module, producing a corresponding "C" language object file. Finally, it uses the C compiler to compile and link these object files into an executable. 16 | 17 | Various options are available to define compiler options and link dependencies. 18 | 19 | ## Command-line Options 20 | 21 | Basic usage is: 22 | 23 | OMake [ options ] { Module } 24 | 25 | to automatically locate and process the source for `Module`. Here `Module` is the module name, and the location and extension of the source file is inferred from the project settings. 26 | 27 | Alternatively: 28 | 29 | OMake [ options ] { path/to/Module.ob2 } 30 | 31 | to process a specific source file. 32 | 33 | `options` are one or more command-line or configuration options (see below). All modules included on the command-line are built as "main" modules using the `-m` compiler option, and are linked to an executable called `Module`. Oberon dialect is selected based on the file extension, which can be configured as outlined below. Other options are: 34 | 35 | * `-read file` 36 | 37 | Reads configuration from the named file. By default, **OMake** looks for configuration in the file `omake.ini` in the current directory. This option allows alternative files to be specified, or for one file to include another file. 38 | 39 | * `-script` 40 | 41 | By default **OMake** calls the compiler and linker to complete the build process. Specifying `-script` causes only the build commands to be output. Such scripts can be used to later build modules without the **OMake** command, for example to bootstrap **OMake** on a system for the first time. 42 | 43 | ## Configuration Options 44 | 45 | **OMake** can be configured on the command-line, or via configuration files. 46 | 47 | On the command line, an option is specified with a hyphen in front of the option name, and any additional parameters for that option are given in the following arguments. For example: 48 | 49 | -script 50 | -read omake.ini 51 | -link "gcc -g" 52 | -set TARGET macOS 53 | 54 | Arguments that include spaces are enclosed within quotes, as required by the shell. 55 | 56 | In configuration files, each option is specified on a separate line beginning with the option name followed by a colon. Any parameters of the option are separated by whitespace, and parameters that include space must be quoted. The following correspond to the above examples: 57 | 58 | script: 59 | read: omake.ini 60 | link: "gcc -g" 61 | set: TARGET macOS 62 | 63 | ### Compiler and linker commands 64 | 65 | The basic compile command is defined by the `compile` option. Example: 66 | 67 | compile: "Ofront+ -88 -s -e" 68 | 69 | The compile command should only define flags that are common to all modules in the project. Additional flags may be appended based on file type. 70 | 71 | Similarly, the link command is defined by the `link` option: 72 | 73 | link: "gcc -Os -g" 74 | 75 | ### File types and paths 76 | 77 | The set of valid module extensions is defined using `extension` options. Each extension defines a set of compiler flags, which are used when compiling modules of that type. This is used to set the language model. **Ofront+** supports Oberon (`-1`), Oberon-2 (`-2`), Oberon-07 (`-7`), Component Pascal (`-C`), and an experimental dialect Oberon-3 (`-3`). The following defines different file extensions for each dialect: 78 | 79 | extension: Mod "-2" 80 | extension: ob "-1" 81 | extension: ob2 "-2" 82 | extension: ob3 "-3" 83 | extension: ob7 "-7" 84 | extension: cp "-C" 85 | 86 | **OMake** needs to know where to find the source code for each imported module. This is specified with the `source` option, which defines a comma-separated list of directories. To locate a module, **OMake** searches each directory in turn, trying each valid extension until it finds a match. 87 | 88 | source: .,test,src/lib,src/aria,[OFRONTLIB] 89 | 90 | Certain built-in modules have no dependencies, and may sometimes have no source files. These can be excluded from module search using the `exclude` option: 91 | 92 | exclude: Platform,SYSTEM 93 | 94 | ### Settings and Environment 95 | 96 | **OMake** uses the `set` option to define parameters which can be substituted elsewhere in other configuration options. This is useful to avoid repeating common settings such as directory paths. The following defines two settings: `OFRONT` for the location of the compiler installation, and `TARGET` for the target type. Two other settings (`OFRONTLIB` and `TARGETLIB`) are derived by substitution. 97 | 98 | set: OFRONT /usr/local/src/OfrontPlus 99 | set: TARGET macOS 100 | set: OFRONTLIB {OFRONT}/Mod/Lib 101 | set: TARGETLIB {OFRONT}/Target/{TARGET}/Lib 102 | 103 | Each setting defines the name of a variable (eg. `OFRONT`) followed by its value (eg. `/usr/local/src/OfrontPlus`). This value can be substituted anywhere else in the configuration file by enclosing the variable name in curly braces (eg. `{OFRONT}`). This will be replaced by the value assigned to the original variable. For example, in the definition of `OFRONTLIB`, the value `{OFRONT}` is replaced by `/usr/local/src/OfrontPlus`, resulting in the value `/usr/local/src/OfrontPlus/Mod/Lib`. 104 | 105 | Environment variables can be used to avoid hard-coded paths, which defers evaluation of the value to the time that the compile and link commands are executed. For example, in the shell: 106 | 107 | export OFRONT=/usr/local/src/OfrontPlus 108 | export TARGET=macOS 109 | 110 | Then in the configuration file, include: 111 | 112 | set: OFRONT $OFRONT 113 | set: TARGET $TARGET 114 | 115 | This has the same effect as the previous example, but allows the variables `OFRONT` and `TARGET` to be controlled by the user's environment, making the configuration file independent of system paths. Occasionally, we need to evaluate an absolute path which may contain such environment variables. For example, when defining a source path to **OMake**. In this situation, we use square brackets instead of curly braces: 116 | 117 | {OFRONTLIB} = $OFRONT/Mod/Lib 118 | [OFRONTLIB] = /usr/local/src/OfrontPlus/Mod/Lib 119 | 120 | Curly braces substitute the literal value; Square brackets causes the evaluation of all environment variables in the value before substitution. 121 | 122 | See the main configuration example below. Currently only `lib` and `source` directives need to know absolute paths, and would therefore be written like this: 123 | 124 | lib: Ofront [OFRONTLIB] 125 | source: .,test,tool,src/lib,src/aria,[OFRONTLIB] 126 | 127 | ### Library Dependencies 128 | 129 | There are two forms of library dependency: 130 | 131 | * Pre-built Oberon-2 libraries such as libOfront 132 | * Interface modules that require external C libraries 133 | 134 | For pre-built libraries we use the `lib` option to define which modules are part of the library. This is done by associating a source directory (in the `source` path) with a link library: 135 | 136 | lib: Ofront [OFRONTLIB] 137 | 138 | The first part of the `lib` option is the name of the library. The second part is the path to the directory containing the library source. If any imported source modules are located within that path, the specified library will be added as a link dependency. 139 | 140 | For interface modules, **OMake** includes the option of defining additional flags and link dependencies using a special directive which can be embedded within the source module. This has the form: 141 | 142 | 'OMAKE' [ flags ] [ 'LINK' lib { ',' lib } ] 143 | 144 | The `OMAKE` directive is be included in a comment between the `MODULE` declaration, and the `IMPORT` list. To define compiler flags, include an optional string after the `OMAKE` keyword. To define link libraries, include the keyword `LINK` followed by a comma-separated list of strings. For Example: 145 | 146 | MODULE Test; 147 | (* OMAKE "-x" LINK "SDL" *) 148 | IMPORT ... 149 | 150 | In this example, "-x" will be added to the compile flags for module `Test`. Any module importing `Test`, either directly or indirectly, will be linked with library "SDL" using the link option "-lSDL". 151 | 152 | To link particular libraries, we may need to define additional paths to header files (-I) or library files (-L). This is done via the `linkflag` option: 153 | 154 | linkflag: Ofront -I{OFRONTLIB} 155 | linkflag: Ofront -I{TARGETLIB}/Obj 156 | linkflag: Ofront -L{TARGETLIB} 157 | linkflag: SDL2 -I/usr/local/include/SDL2 158 | linkflag: cairo -I/usr/local/include/cairo 159 | 160 | The first part defines the name of a library, as identified either through a `lib` directive, or via `OMAKE LINK`. The second part defines the corresponding flags that should be used by the linker when including this library. Multiple flags can be defined by quoting a string of flags, or by repeating the `linkflag` directive. 161 | 162 | These flags may vary between systems depending on the location of library files and headers. If a library is available as part of the operating system distribution, then additional flags may not be necessary. If instead the library has been installed by the user, it may be in a local directory. Of course, it is also possible to define such dependencies in the `link` command, or via the environment (eg. like `CFLAGS`). 163 | 164 | Some libraries must always be linked regardless of imports, because they contain essential parts of the run-time system. Required link libraries can be declared using the `require` option: 165 | 166 | require: Ofront 167 | 168 | Some "header-only" libraries have all implementation code contained in C header files. Such libraries require `linkflags` but have no corresponding `-l` library. Header-only libraries can be declared like this: 169 | 170 | linkflag: CK -I/usr/local/include 171 | linkflag: CK NOLIB 172 | 173 | The `NOLIB` flag instructs the linker to omit the usual `-l` library, but all other `linkflag` values are output as usual. 174 | 175 | Once the set of required libraries has been determined (via the `lib`, `OMAKE` and `require`) the following link command is executed: 176 | 177 | linkcmd { linkflags } [ objs ] -o Module { libs } 178 | 179 | Where: 180 | 181 | * *linkcmd* is the linker command defined by `link` 182 | * *linkflags* are the flags declared for for all required libraries 183 | * *objs* are all the required object files that are not contained in other libraries 184 | * *main* is the name of the main module, and *main.c* is its object file 185 | * *libs* are `-l` directives for each required library 186 | 187 | ## To Do 188 | 189 | Features to add in the future: 190 | 191 | * *Improved error reporting*. **OMake** reports the location of errors in the source file, but description of the error should be improved, and should not include token codes. This most often occurs when there is an error in the `MODULE` or `IMPORT` statement, or if an imported module cannot be found. 192 | * *Build libraries*. Currently **OMake** compiles directly from `.c` to build an executable, but for building libraries it should generate intermediate `.o` files, and use the `ar` archiver. There should also be a method to describe which modules to include in the library. Some options might be: 193 | 1. All source files in a module directory. This would require the ability to enumerate files in a directory, which is not currently in the Platform implementation. 194 | 2. A "manifest" file that specifies a list of module names 195 | 3. A "root" module that imports all of the modules to be included 196 | * *Incremental build*. Currently **OMake** builds all imported modules that are not part of a pre-linked library. This is usually quite fast, but a module only really needs to be recompiled if it has changed since the last compilation, or if one of its imports have changed. One way to check this would be to compare the modification times of the module source and the symbol file. 197 | * *Filter compiler options*. Some modules may disable run-time checks for speed. Optionally we may want to suppress such flags, to build a "safer" version of the code. 198 | * *Better help message*. The default help message shows the default state for options, but at present this only works for simple "scalar" values. It should also output some of the more complex options which involved lists and/or associations (eg. "-set"). 199 | * *Simplify handling of absolute paths*. As described, square brackets must be used to resolve absolute paths for `lib` and `source` directives. This resolution should probably be built in to these commands, so that either `{}` or `[]` forms can be used with the same effect. 200 | 201 | ## Configuration example 202 | 203 | ``` 204 | # ---- BEGIN - OMake configuration file 205 | 206 | # Location of OfrontPlus distribution 207 | set: OFRONT $OFRONT 208 | 209 | # Name of target (eg. macOS, Win64, Linux_amd64, BlackBox) 210 | # see list of targets in $OFRONT/Target 211 | set: TARGET $OTARGET 212 | 213 | # Location of Ofront library source files. 214 | # Required by OMake to locate library sources, and by linker for include files 215 | set: OFRONTLIB {OFRONT}/Mod/Lib 216 | 217 | # Location of Ofront library object files. 218 | # Required by linker to locate library object files (.c) 219 | set: TARGETLIB {OFRONT}/Target/{TARGET}/Lib 220 | 221 | # Paths to source code files. Path elements are separated by commas 222 | 223 | source: .,test,tool,src/lib,src/aria,[OFRONTLIB] 224 | 225 | # ---- Module extensions 226 | # Here we list the valid module extensions, and any compiler flags 227 | # associated with file type. Use this to define Oberon dialects 228 | # 229 | # arg 1: Module extension without leading "." 230 | # arg 2: List of associated compiler flags 231 | 232 | extension: Mod "-2" 233 | extension: ob "-1" 234 | extension: ob2 "-2" 235 | extension: ob3 "-3" 236 | extension: ob7 "-7" 237 | extension: CP "-C" 238 | 239 | # ---- Ofront+ compile command 240 | 241 | compile: "Ofront+ -88 -s -e" 242 | 243 | # ---- Link command 244 | # Always include OFRONTLIB for SYSTEM.oh 245 | 246 | link: "gcc -Os -g" 247 | 248 | # ---- Built-in modules without source files 249 | # OMake will not attempt to locate and parse these modules 250 | 251 | exclude: Platform,SYSTEM 252 | 253 | # ---- Source directories that represent libraries 254 | # A source file located in the directory is assumed part of the library 255 | # which causes the library to be added to the linker command 256 | # 257 | # arg 1: Library name 258 | # arg 2: Directory containing library source files 259 | 260 | lib: Ofront [OFRONTLIB] 261 | 262 | # ---- Libraries that must always be linked (eg. for the language runtime) 263 | 264 | require: Ofront 265 | 266 | # ---- Linker flags required by various libraries 267 | # This defines any additional flags (eg. -I, -L) required by the link 268 | # command (ie. gcc) to link the program. Do not add -l flags here as 269 | # these are added implicitly by OMake 270 | # 271 | # arg 1: Library name 272 | # arg 2: Linker flags (eg. -I, -L) required for library 273 | 274 | linkflag: Ofront -I{OFRONTLIB} 275 | linkflag: Ofront -I{TARGETLIB}/Obj 276 | linkflag: Ofront -L{TARGETLIB} 277 | 278 | linkflag: SDL2 -I/usr/local/include/SDL2 279 | linkflag: CK -I$HOME/local/include 280 | linkflag: CK NOLIB 281 | linkflag: cairo -I/usr/local/include/cairo 282 | 283 | # ---- END 284 | ``` 285 | -------------------------------------------------------------------------------- /omake.ini: -------------------------------------------------------------------------------- 1 | # ---- BEGIN - OMake configuration file 2 | 3 | # Location of OfrontPlus distribution 4 | set: OFRONT $OFRONT 5 | 6 | # Name of target (eg. macOS, Win64, Linux_amd64, BlackBox) 7 | # see list of targets in $OFRONT/Target 8 | set: TARGET $OTARGET 9 | 10 | # Location of Ofront library source files. 11 | # Required by OMake to locate library sources, and by linker for include files 12 | set: OFRONTLIB {OFRONT}/Mod/Lib 13 | 14 | # Location of Ofront library object files. 15 | # Required by linker to locate library object files (.c) 16 | set: TARGETLIB {OFRONT}/Target/{TARGET}/Lib 17 | 18 | # Paths to source code files. Path elements are separated by commas 19 | 20 | source: .,test,src/aria,src/lib,src/tool,[OFRONTLIB] 21 | 22 | # ---- Module extensions 23 | # Here we list the valid module extensions, and any compiler flags 24 | # associated with file type. Use this to define Oberon dialects 25 | # 26 | # arg 1: Module extension without leading "." 27 | # arg 2: List of associated compiler flags 28 | 29 | extension: Mod "-2" 30 | extension: ob "-1" 31 | extension: ob2 "-2" 32 | extension: ob3 "-3" 33 | extension: ob7 "-7" 34 | extension: cp "-C" 35 | 36 | # ---- Ofront+ compile command 37 | 38 | compile: "ofront+ -88 -s -e" 39 | 40 | # ---- Link comand 41 | # Always include OFRONTLIB for SYSTEM.oh 42 | 43 | # link: "gcc -g -O3 -fomit-frame-pointer -fno-exceptions -fno-unwind-tables -fno-asynchronous-unwind-tables -ffunction-sections -I{OFRONTLIB}" 44 | 45 | link: "gcc -O3 -g3" 46 | 47 | # ---- Built-in modules without source files 48 | # OMake will not attempt to locate and parse these modules 49 | 50 | exclude: Platform,SYSTEM 51 | 52 | # ---- Source directories that represent libraries 53 | # A source file located in the directory is assumed part of the library 54 | # which causes the library to be added to the linker command 55 | # 56 | # arg 1: Library name 57 | # arg 2: Directory containing library source files 58 | 59 | lib: Ofront [OFRONTLIB] 60 | 61 | # ---- Libraries that must always be linked (eg. for the language runtime) 62 | 63 | require: Ofront 64 | 65 | # ---- Linker flags required by various libraries 66 | # This defines any additional flags (eg. -I, -L) required by the link 67 | # command (ie. gcc) to link the program. Do not add -l flags here as 68 | # these are added implicitly by OMake 69 | # 70 | # arg 1: Library name 71 | # arg 2: Linker flags (eg. -I, -L) required for library 72 | 73 | linkflag: Ofront -I{OFRONTLIB} 74 | linkflag: Ofront -I{TARGETLIB}/Obj 75 | linkflag: Ofront -L{TARGETLIB} 76 | 77 | linkflag: SDL2 -I/usr/include/SDL2 78 | linkflag: cairo -I/usr/include/cairo 79 | linkflag: CK -I$HOME/local/include 80 | linkflag: CK NOLIB 81 | 82 | # ---- END 83 | -------------------------------------------------------------------------------- /script/build-omake.sh: -------------------------------------------------------------------------------- 1 | # OMake generated script for OMake 2 | ofront+ -88 -s -e -2 src/aria/arStrings.ob2 3 | ofront+ -88 -s -e -2 src/aria/arStringList.ob2 4 | ofront+ -88 -s -e -2 src/aria/arStringAssoc.ob2 5 | ofront+ -88 -s -e -2 src/aria/arC.ob2 6 | ofront+ -88 -s -e -2 src/aria/arCFormat.ob2 7 | ofront+ -88 -s -e -2 src/aria/arText.ob2 8 | ofront+ -88 -s -e -2 src/aria/arChar.ob2 9 | ofront+ -88 -s -e -2 src/aria/arFile.ob2 10 | ofront+ -88 -s -e -2 src/aria/arOut.ob2 11 | ofront+ -88 -s -e -2 src/aria/arPattern.ob2 12 | ofront+ -88 -s -e -2 src/aria/arSize.ob2 13 | ofront+ -88 -s -e -2 src/aria/arConfiguration.ob2 14 | ofront+ -88 -s -e -2 src/aria/arPath.ob2 15 | ofront+ -88 -s -e -2 -m src/tool/OMake.ob2 16 | gcc -O3 -g3 -I$OFRONT/Mod/Lib -I$OFRONT/Target/$OTARGET/Lib/Obj -L$OFRONT/Target/$OTARGET/Lib arPath.c arSize.c arFile.c arOut.c arChar.c arC.c arCFormat.c arText.c arPattern.c arConfiguration.c arStringList.c arStringAssoc.c arStrings.c OMake.c -o OMake -lOfront 17 | -------------------------------------------------------------------------------- /src/aria/arArgs.ob2: -------------------------------------------------------------------------------- 1 | MODULE arArgs; (* jt, 8.12.94 *) 2 | 3 | IMPORT SYSTEM, Platform; 4 | 5 | TYPE 6 | ArgPtr* = POINTER [notag] TO ARRAY 1024 OF CHAR; 7 | ArgVec* = POINTER [notag] TO ARRAY 1024 OF ArgPtr; 8 | 9 | VAR argc-: LONGINT; argv-: ArgVec; 10 | 11 | PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; 12 | PROCEDURE -Argv(): ArgVec "(arArgs_ArgVec)SYSTEM_argv"; 13 | PROCEDURE getmainargs ["__getmainargs"] (VAR argc: LONGINT; VAR argv: ArgVec; 14 | VAR env: SYSTEM.PTR; wildcard: LONGINT; VAR startupinfo: SYSTEM.PTR): LONGINT; 15 | PROCEDURE -getMainArgs 16 | "void *tmp; __getmainargs(&arArgs_argc, &arArgs_argv, &tmp, 0, &tmp)"; 17 | 18 | BEGIN 19 | IF Platform.Windows THEN getMainArgs 20 | ELSE argc := Argc(); argv := Argv() 21 | END 22 | END arArgs. 23 | -------------------------------------------------------------------------------- /src/aria/arC.ob2: -------------------------------------------------------------------------------- 1 | (* Definitions for C types - Should be available in SYSTEM? *) 2 | 3 | MODULE arC; 4 | 5 | IMPORT SYSTEM; 6 | 7 | TYPE 8 | char* = SYSTEM.CHAR8; 9 | uchar* = SYSTEM.BYTE; 10 | 11 | string* = POINTER [notag] TO ARRAY [notag] OF char; 12 | 13 | short* = SYSTEM.INT16; 14 | int* = SYSTEM.INT32; 15 | longint* = SYSTEM.INT64; 16 | 17 | float* = SYSTEM.REAL32; 18 | double* = SYSTEM.REAL64; 19 | 20 | enum* = int; 21 | set* = int; 22 | address* = SYSTEM.ADRINT; 23 | pointer* = SYSTEM.PTR; 24 | 25 | END arC. 26 | -------------------------------------------------------------------------------- /src/aria/arCFormat.ob2: -------------------------------------------------------------------------------- 1 | (* Conversions to and from strings for integers and reals. This is done using 2 | the C standard sscanf and snprintf functions defined in stdio.h. Note that 3 | snprintf is safe, since we pass the array size. We can't check if the 4 | format matches the argument, so use with caution. However, the C compiler 5 | should emit a warning if the wrong format is used. *) 6 | 7 | MODULE arCFormat; 8 | 9 | IMPORT 10 | SYSTEM, 11 | C := arC; 12 | 13 | PROCEDURE -includeStdio* "#include "; 14 | 15 | PROCEDURE -IntToString*(VAR result : ARRAY OF CHAR; format : ARRAY OF CHAR; value : C.int) 16 | "snprintf(result, result__len, (const char *)format, value)"; 17 | 18 | PROCEDURE -RealToString*(VAR result : ARRAY OF CHAR; format : ARRAY OF CHAR; value : C.double) 19 | "snprintf(result, result__len, (const char *)format, value)"; 20 | 21 | PROCEDURE -StringToString*(VAR result : ARRAY OF CHAR; format : ARRAY OF CHAR; value : ARRAY OF CHAR) 22 | "snprintf(result, result__len, (const char *)format, (const char *)value)"; 23 | 24 | PROCEDURE -StringToInt*(str : ARRAY OF CHAR; VAR value : C.int) : C.int 25 | 'sscanf((const char *)str, "%d", value)'; 26 | 27 | PROCEDURE -StringToReal*(str : ARRAY OF CHAR; VAR value : C.double) : C.int 28 | 'sscanf((const char *)str, "%lf", value)'; 29 | 30 | END arCFormat. 31 | -------------------------------------------------------------------------------- /src/aria/arCString.ob2: -------------------------------------------------------------------------------- 1 | (* Utility functions to handle C strings *) 2 | 3 | MODULE arCString; 4 | 5 | IMPORT SYSTEM, C := arC; 6 | 7 | TYPE 8 | String* = POINTER TO ARRAY OF CHAR; 9 | 10 | PROCEDURE -includeString* "#include "; 11 | 12 | PROCEDURE -strlen(argStr : C.string) : C.int 13 | "strlen((const char *)argStr)"; 14 | 15 | PROCEDURE -strncpy(dst, src : C.string; len : C.int) : C.string 16 | "strncpy((char *)dst, (const char *)src, len)"; 17 | 18 | (* Copy a C string into an ARRAY OF CHAR *) 19 | 20 | PROCEDURE CopyToArray*(src : C.string; VAR dst : ARRAY OF CHAR); 21 | VAR 22 | dummy : C.string; 23 | BEGIN 24 | dummy := strncpy(SYSTEM.VAL(C.string, SYSTEM.ADR(dst)), src, LEN(dst)); 25 | END CopyToArray; 26 | 27 | (* Copy a C string into an array that is dynamically allocated to fit *) 28 | 29 | PROCEDURE Copy*(src : C.string) : String; 30 | VAR 31 | result : String; 32 | i, len : LONGINT; 33 | BEGIN 34 | len := strlen(src); 35 | NEW(result, len+1); 36 | CopyToArray(src, result^); 37 | RETURN result; 38 | END Copy; 39 | 40 | END arCString. 41 | -------------------------------------------------------------------------------- /src/aria/arChar.ob2: -------------------------------------------------------------------------------- 1 | (* Functions for common character classes *) 2 | 3 | MODULE arChar; 4 | 5 | PROCEDURE IsLetter*(ch : CHAR) : BOOLEAN; 6 | BEGIN 7 | RETURN ((ch >= 'A') & (ch <= 'Z')) OR ((ch >= 'a') & (ch <= 'z')) 8 | END IsLetter; 9 | 10 | PROCEDURE IsDigit*(ch : CHAR) : BOOLEAN; 11 | BEGIN 12 | RETURN (ch >= '0') & (ch <= '9'); 13 | END IsDigit; 14 | 15 | PROCEDURE IsAlphaNumeric*(ch : CHAR) : BOOLEAN; 16 | BEGIN 17 | RETURN IsLetter(ch) OR IsDigit(ch) 18 | END IsAlphaNumeric; 19 | 20 | PROCEDURE IsSpace*(ch : CHAR) : BOOLEAN; 21 | BEGIN 22 | RETURN (ch = ' ') OR (ch = 09X) OR (ch = 0AX) OR (ch = 0DX); 23 | END IsSpace; 24 | 25 | END arChar. 26 | -------------------------------------------------------------------------------- /src/aria/arConfiguration.ob2: -------------------------------------------------------------------------------- 1 | 2 | (* Configuration - Setting program options via command line or configuration file 3 | 4 | This module handles: 5 | Setting and validating values via the command line 6 | Reading parameter values from a configuration file 7 | Printing usage help text, including options and default values 8 | 9 | Each program parameter is declared with: 10 | name, 11 | description, 12 | type information (eg. maximum, minimum value) 13 | default value 14 | 15 | Create a parameter using one of the following: 16 | NewBoolean(name, desc, default) 17 | NewInteger(name, desc, default, min, max) 18 | NewString(name, desc, default) 19 | NewAssoc(name, desc, multi) 20 | 21 | includes the name and a description of any parameters. For example: 22 | "tabs " 23 | "debug" 24 | The returned object has a field of the corresponding type. 25 | 26 | To scan parameters from the command line: 27 | C.ScanOptions(pos); 28 | which returns the position of the first parameter that is not an option 29 | 30 | To scan parameters from a file: 31 | success := C.ReadOptions("program.ini") 32 | which returns TRUE if the file was processed, and FALSE if it cannot be opened. 33 | 34 | Example: 35 | IMPORT C := Configuration; 36 | VAR 37 | tabs : C.Integer; 38 | debug : C.Boolean; 39 | ... 40 | tabs := C.NewInteger("tabs ", "Set spaces per tab", 2, 1, C.None); 41 | debug := C.NewBoolean("debug", "Enable debugging output", FALSE); 42 | ... 43 | IF debug.value THEN 44 | Console.String("Tabs are set to "); Out.Int(tabs.value, 0); Out.Ln; 45 | ... 46 | success := C.ReadOptions("program.ini") 47 | pos := 1; 48 | C.ScanOptions(pos); 49 | ... handle any positional parameters 50 | C.CheckFinished(pos); 51 | *) 52 | 53 | (* SG 2020/08/27 *) 54 | 55 | MODULE arConfiguration; 56 | 57 | IMPORT 58 | Kernel, 59 | Console, 60 | Args := arArgs, 61 | Files, 62 | 63 | Size := arSize, 64 | SA := arStringAssoc, 65 | SL := arStringList, 66 | P := arPattern, 67 | Strings := arStrings; 68 | 69 | CONST 70 | None* = MIN(INTEGER)+1; (* maximum or minimum is not defined *) 71 | 72 | TYPE 73 | Handler* = PROCEDURE(argv : SL.Array; VAR pos : LONGINT); 74 | 75 | Value* = POINTER TO ValueDesc; 76 | ValueDesc* = RECORD 77 | name- : SL.String; 78 | synopsis- : SL.String; 79 | desc- : SL.String; 80 | next- : Value; 81 | END; 82 | 83 | Boolean* = POINTER TO RECORD (ValueDesc) 84 | value* : BOOLEAN; 85 | END; 86 | 87 | Integer* = POINTER TO RECORD (ValueDesc) 88 | value*: INTEGER; 89 | min-, max- : INTEGER; 90 | END; 91 | 92 | String* = POINTER TO RECORD (ValueDesc) 93 | value*: SL.String; 94 | END; 95 | 96 | Procedure* = POINTER TO RECORD (ValueDesc) 97 | value: Handler; 98 | END; 99 | 100 | Assoc* = POINTER TO RECORD (ValueDesc) 101 | value* : SA.Assoc; 102 | multi- : BOOLEAN; 103 | END; 104 | 105 | VAR 106 | (* copy of arg vector as an Oberon structure *) 107 | argc : LONGINT; 108 | argv- : SL.Array; 109 | 110 | (* list of all configuration values *) 111 | values- : Value; 112 | 113 | banner : SL.String; 114 | 115 | settings : Assoc; 116 | 117 | (* Platform.ArgPtr is not exported :-( 118 | 119 | PROCEDURE CopyArgPtr(p : Platform.ArgPtr) : SL.String; 120 | VAR len, i : INTEGER; result : SL.String; 121 | BEGIN 122 | len := 0; 123 | WHILE p[len] # 0X DO 124 | INC(len); 125 | END: 126 | NEW(result, len+1); 127 | FOR i := 0 TO len DO 128 | result[i] := p[i] 129 | END; 130 | RETURN result; 131 | END CopyArgPtr; 132 | *) 133 | 134 | (* Copy C argument vector into an Oberon array *) 135 | 136 | PROCEDURE CopyArgVec(p : Args.ArgVec) : SL.Array; 137 | VAR 138 | len, strLen : INTEGER; 139 | i, j : INTEGER; 140 | result : SL.Array; 141 | BEGIN 142 | len := 0; 143 | WHILE p[len] # NIL DO 144 | INC(len); 145 | END; 146 | NEW(result, len); 147 | FOR i := 0 TO len-1 DO 148 | (* calculate length of C arg *) 149 | strLen := 0; 150 | WHILE p[i][strLen] # 0X DO 151 | INC(strLen) 152 | END; 153 | (* copy arg into Oberon string *) 154 | NEW(result[i], strLen+1); 155 | FOR j := 0 TO strLen DO 156 | result[i][j] := p[i][j] 157 | END; 158 | END; 159 | RETURN result; 160 | END CopyArgVec; 161 | 162 | (* ------ Value ------ *) 163 | 164 | PROCEDURE (self : Value) Init*(name, desc: ARRAY OF CHAR); 165 | VAR parts : SL.Array; 166 | BEGIN 167 | self.synopsis := SL.Copy(name); 168 | parts := P.Split(name, " "); 169 | self.name := parts[0]; 170 | self.desc := SL.Copy(desc); 171 | self.next := values; 172 | values := self; 173 | END Init; 174 | 175 | (* output the current value as text *) 176 | 177 | PROCEDURE (self : Value) Format*; 178 | BEGIN 179 | (* abstract *) 180 | END Format; 181 | 182 | (* Scan as many command line arguments as required from position in the 183 | argument array . On any errors, show usage and halt. After consuming the 184 | argument, increment to indicate the position of the next unused argument. 185 | *) 186 | 187 | PROCEDURE (self : Value) Accept*(argv : SL.Array; VAR pos : LONGINT); 188 | BEGIN 189 | (* abstract *) 190 | END Accept; 191 | 192 | (* ------ Scanning and printing ------ *) 193 | 194 | (* Output spaces *) 195 | 196 | PROCEDURE Spaces(count : LONGINT); 197 | BEGIN 198 | WHILE count > 0 DO 199 | Console.Char(" "); DEC(count); 200 | END; 201 | END Spaces; 202 | 203 | PROCEDURE OutString(string : ARRAY OF CHAR); 204 | VAR i : LONGINT; ch : CHAR; 205 | BEGIN 206 | i := 0; 207 | LOOP 208 | ch := string[i]; 209 | IF ch = 0X THEN RETURN END; 210 | INC(i); 211 | IF ch = '\' THEN 212 | IF string[i] = 'n' THEN 213 | Console.Ln; INC(i); 214 | ELSE 215 | Console.Char(ch); 216 | END; 217 | ELSE 218 | Console.Char(ch); 219 | END; 220 | END; 221 | END OutString; 222 | 223 | (* Show program usage *) 224 | 225 | PROCEDURE Usage*; 226 | VAR 227 | value : Value; 228 | nameWidth, descWidth, length, sLength: LONGINT; 229 | BEGIN 230 | IF banner # NIL THEN 231 | OutString(banner^); 232 | END; 233 | (* compute maximum name and description width *) 234 | nameWidth := 0; descWidth := 0; length := 0; 235 | value := values; 236 | WHILE value # NIL DO 237 | nameWidth := Size.Max(nameWidth, Strings.Length(value.synopsis^)); 238 | descWidth := Size.Max(descWidth, Strings.Length(value.desc^)); 239 | INC(length); 240 | value := value.next; 241 | END; 242 | 243 | (* limit space in case of very long names *) 244 | nameWidth := Size.Min(nameWidth, 15); 245 | 246 | IF length > 0 THEN 247 | Console.String("Options:"); Console.Ln; 248 | value := values; 249 | WHILE value # NIL DO 250 | Console.String(" "); 251 | Console.Char("-"); Console.String(value.synopsis^); 252 | sLength := Strings.Length(value.synopsis^); 253 | (* take a separate line if name is too long *) 254 | IF sLength > nameWidth THEN 255 | Console.Ln; Spaces(3+nameWidth); 256 | ELSE 257 | Spaces(nameWidth-sLength); 258 | END; 259 | Console.String(" "); 260 | Console.String(value.desc^); Spaces(1+descWidth-Strings.Length(value.desc^)); 261 | Console.Char("("); value.Format; Console.Char(")"); 262 | Console.Ln; 263 | value := value.next; 264 | END; 265 | END; 266 | END Usage; 267 | 268 | (* Show usage and exit with error *) 269 | 270 | PROCEDURE Error; 271 | BEGIN 272 | Usage(); 273 | Kernel.Exit(1); 274 | END Error; 275 | 276 | (* Show usage and exit cleanly *) 277 | 278 | PROCEDURE Help(argv : SL.Array; VAR pos : LONGINT); 279 | BEGIN 280 | Usage(); 281 | Kernel.Exit(0); 282 | END Help; 283 | 284 | (* get an argument, and halt if none remain. Apply substitutions for any 285 | "set" values *) 286 | 287 | PROCEDURE GetArg*(argv : SL.Array; VAR pos : LONGINT; VAR arg : SL.String); 288 | BEGIN 289 | IF pos < LEN(argv^) THEN 290 | arg := P.Substitute(argv[pos]^, settings.value); INC(pos); 291 | ELSE 292 | Console.String("Missing argument at position "); Console.Int(pos, 0); 293 | Console.Ln; 294 | Error; 295 | END; 296 | END GetArg; 297 | 298 | (* parse integer from string, setting and returning TRUE when valid *) 299 | 300 | PROCEDURE ParseInteger*(VAR arg : ARRAY OF CHAR; VAR result : INTEGER) : BOOLEAN; 301 | VAR 302 | value, sign, pos : INTEGER; 303 | ch : CHAR; 304 | BEGIN 305 | (* parse integer *) 306 | value := 0; sign := 1; 307 | pos := 0; ch := arg[0]; 308 | IF ch = '-' THEN 309 | sign := -1; 310 | INC(pos); ch := arg[pos]; 311 | END; 312 | WHILE (ch >= '0') & (ch <= '9') DO 313 | value := value * 10 + ORD(ch) - ORD('0'); 314 | INC(pos); ch := arg[pos]; 315 | END; 316 | IF ch # 0X THEN RETURN FALSE END; 317 | result := value * sign; 318 | RETURN TRUE; 319 | END ParseInteger; 320 | 321 | (* parse boolean from string, setting and returning TRUE when valid *) 322 | 323 | PROCEDURE ParseBoolean*(VAR arg : ARRAY OF CHAR; VAR result : BOOLEAN) : BOOLEAN; 324 | BEGIN 325 | IF Strings.Equal(arg, "TRUE") THEN 326 | result := TRUE; 327 | ELSIF Strings.Equal(arg, "FALSE") THEN 328 | result := FALSE; 329 | ELSE 330 | RETURN FALSE; 331 | END; 332 | RETURN TRUE; 333 | END ParseBoolean; 334 | 335 | (* find an option with the given *) 336 | 337 | PROCEDURE FindOption(name : ARRAY OF CHAR) : Value; 338 | VAR value : Value; 339 | BEGIN 340 | value := values; 341 | WHILE value # NIL DO 342 | IF Strings.Equal(value.name^, name) THEN 343 | RETURN value; 344 | END; 345 | value := value.next; 346 | END; 347 | RETURN NIL; 348 | END FindOption; 349 | 350 | (* If an option is at the current position, process it, update pos and RETURN 351 | TRUE *) 352 | 353 | PROCEDURE CheckOption*(VAR pos : LONGINT) : BOOLEAN; 354 | VAR 355 | arg : SL.String; 356 | value : Value; 357 | option : SL.String; length : Strings.LengthType; 358 | BEGIN 359 | arg := argv[pos]; 360 | IF arg[0] = '-' THEN 361 | INC(pos); 362 | length := Strings.Length(arg^); NEW(option, length); 363 | Strings.Extract(arg^, 1, length-1, option^); 364 | value := FindOption(option^); 365 | IF value = NIL THEN 366 | Console.String("ERROR: Unknown option: "); Console.String(option^); 367 | Console.Ln; 368 | Error; 369 | END; 370 | value.Accept(argv, pos); 371 | RETURN TRUE; 372 | END; 373 | RETURN FALSE; 374 | END CheckOption; 375 | 376 | (* Process a sequence of options on the command line. Return the argument 377 | position of the first argument that is not an option. Options start with '-', 378 | and may include an additional argument specifying a value *) 379 | 380 | PROCEDURE ScanOptions*(VAR pos : LONGINT); 381 | BEGIN 382 | WHILE (pos < argc) & CheckOption(pos) DO 383 | END; 384 | END ScanOptions; 385 | 386 | PROCEDURE SetBanner*(text : ARRAY OF CHAR); 387 | BEGIN 388 | banner := SL.Copy(text); 389 | END SetBanner; 390 | 391 | PROCEDURE ReadLineFromFile(VAR line : ARRAY OF CHAR; VAR rd : Files.Rider) : BOOLEAN; 392 | VAR 393 | i : INTEGER; 394 | ch : CHAR; 395 | BEGIN 396 | i := 0; 397 | Files.ReadChar(rd, ch); 398 | IF ch = 0X THEN RETURN FALSE END; 399 | WHILE (ch # 0AX) & (ch # 0X) DO 400 | IF (ch # 0DX) & (i < LEN(line)-1) THEN 401 | line[i] := ch; INC(i); 402 | END; 403 | Files.ReadChar(rd, ch); 404 | END; 405 | line[i] := 0X; 406 | RETURN TRUE; 407 | END ReadLineFromFile; 408 | 409 | (* Read options from file *) 410 | 411 | PROCEDURE ReadOptions*(fileName : ARRAY OF CHAR) : BOOLEAN; 412 | VAR 413 | line : ARRAY 1024 OF CHAR; 414 | nLines : INTEGER; 415 | match : SL.Array; 416 | rd : Files.Rider; 417 | file : Files.File; 418 | name : SL.String; 419 | value : Value; 420 | pos : LONGINT; 421 | 422 | PROCEDURE ErrorLine(reason, context : ARRAY OF CHAR); 423 | BEGIN 424 | Console.String("ERROR: "); Console.String(reason); 425 | Console.String(" '"); Console.String(context); 426 | Console.String("' on line "); Console.Int(nLines, 0); 427 | Console.String(" of file "); Console.String(fileName); 428 | Console.Ln; 429 | Error; 430 | END ErrorLine; 431 | 432 | BEGIN 433 | file := Files.Old(fileName); 434 | IF file = NIL THEN 435 | RETURN FALSE; 436 | END; 437 | Files.Set(rd, file, 0); 438 | nLines := 0; 439 | WHILE ReadLineFromFile(line, rd) DO 440 | INC(nLines); 441 | IF (line[0] = 0X) OR (line[0] = '#') THEN 442 | (* ignore empty lines and comments *) 443 | ELSIF P.Match("*: *", line, match) THEN 444 | name := match[0]; 445 | value := FindOption(name^); 446 | IF value = NIL THEN 447 | ErrorLine("Unknown option", name^); 448 | END; 449 | match := P.ParseArgs(match[1]^); 450 | pos := 0; 451 | value.Accept(match, pos); 452 | ELSE 453 | ErrorLine("Malformed line", line); 454 | END; 455 | END; 456 | Files.Close(file); 457 | RETURN TRUE; 458 | END ReadOptions; 459 | 460 | PROCEDURE Read(argv : SL.Array; VAR pos : LONGINT); 461 | VAR 462 | arg : SL.String; 463 | BEGIN 464 | GetArg(argv, pos, arg); 465 | IF ~ReadOptions(arg^) THEN 466 | Console.String("Cannot read file: "); Console.String(arg^); Console.Ln; 467 | Error; 468 | END; 469 | END Read; 470 | 471 | (* Make sure there are no extraneous arguments after *) 472 | 473 | PROCEDURE CheckFinished*(pos : LONGINT); 474 | BEGIN 475 | IF pos # argc THEN 476 | Console.String("Unexpected arguments"); Console.Ln; 477 | Error; 478 | END; 479 | END CheckFinished; 480 | 481 | (* ------ Boolean ------ *) 482 | 483 | PROCEDURE (self : Boolean) Format*; 484 | BEGIN 485 | IF self.value THEN 486 | Console.String("TRUE"); 487 | ELSE 488 | Console.String("FALSE"); 489 | END 490 | END Format; 491 | 492 | PROCEDURE (self : Boolean) Accept*(argv : SL.Array; VAR pos : LONGINT); 493 | VAR arg : SL.String; 494 | BEGIN 495 | IF pos self.max)) THEN 537 | Console.String("ERROR: Value "); Console.Int(value, 0); 538 | IF self.min = None THEN 539 | Console.String(" is greater than maximum of "); Console.Int(self.max, 0); 540 | ELSIF self.max = None THEN 541 | Console.String(" is less than minimum of "); Console.Int(self.min, 0); 542 | ELSE 543 | Console.String(" out of range "); 544 | Console.Int(self.min, 0); Console.String(" ... "); Console.Int(self.max, 0); 545 | END; 546 | Console.Ln; 547 | Error; 548 | END; 549 | 550 | self.value := value; 551 | END Accept; 552 | 553 | (* Create Integer with default value, minimum and maximum *) 554 | 555 | PROCEDURE NewInteger*(name, desc : ARRAY OF CHAR; default, min, max : INTEGER) : Integer; 556 | VAR result : Integer; 557 | BEGIN 558 | NEW(result); 559 | result.Init(name, desc); 560 | result.value := default; 561 | result.min := min; 562 | result.max := max; 563 | RETURN result; 564 | END NewInteger; 565 | 566 | (* ------ String ------ *) 567 | 568 | PROCEDURE StringWidth(value : ARRAY OF CHAR; width : INTEGER); 569 | VAR i : INTEGER; length : Strings.LengthType; 570 | BEGIN 571 | length := Strings.Length(value); 572 | IF length > width-3 THEN 573 | FOR i := 0 TO width-4 DO 574 | Console.Char(value[i]) 575 | END; 576 | Console.String("..."); 577 | ELSE 578 | Console.String(value); 579 | END; 580 | END StringWidth; 581 | 582 | PROCEDURE (self : String) Format*; 583 | BEGIN 584 | Console.Char('"'); 585 | Console.String(self.value^); 586 | (* StringWidth(self.value^, 16); *) 587 | Console.Char('"'); 588 | END Format; 589 | 590 | PROCEDURE (self : String) Accept*(argv : SL.Array; VAR pos : LONGINT); 591 | BEGIN 592 | GetArg(argv, pos, self.value); 593 | END Accept; 594 | 595 | PROCEDURE NewString*(name, desc : ARRAY OF CHAR; default : ARRAY OF CHAR) : String; 596 | VAR result : String; 597 | BEGIN 598 | NEW(result); 599 | result.Init(name, desc); 600 | result.value := SL.Copy(default); 601 | RETURN result; 602 | END NewString; 603 | 604 | (* ------ Procedure ------ *) 605 | 606 | PROCEDURE (self : Procedure) Accept*(argv : SL.Array; VAR pos : LONGINT); 607 | BEGIN 608 | self.value(argv, pos); 609 | END Accept; 610 | 611 | PROCEDURE NewProcedure*(name, desc : ARRAY OF CHAR; value : Handler); 612 | VAR result : Procedure; 613 | BEGIN 614 | NEW(result); 615 | result.Init(name, desc); 616 | result.value := value; 617 | END NewProcedure; 618 | 619 | (* ------ Assoc ------ *) 620 | 621 | PROCEDURE (self : Assoc) Accept*(argv : SL.Array; VAR pos : LONGINT); 622 | VAR key, value : SL.String; 623 | BEGIN 624 | GetArg(argv, pos, key); 625 | GetArg(argv, pos, value); 626 | IF self.multi THEN 627 | SA.Set0(self.value, key^, value^); 628 | ELSE 629 | SA.Set(self.value, key^, value^); 630 | END; 631 | END Accept; 632 | 633 | PROCEDURE NewAssoc*(name, desc : ARRAY OF CHAR; multi : BOOLEAN) : Assoc; 634 | VAR result : Assoc; 635 | BEGIN 636 | NEW(result); 637 | result.Init(name, desc); 638 | result.value := NIL; 639 | result.multi := multi; 640 | RETURN result; 641 | END NewAssoc; 642 | 643 | BEGIN 644 | argv := CopyArgVec(Args.argv); 645 | argc := LEN(argv^); 646 | banner := NIL; 647 | values := NIL; 648 | NewProcedure("help", "Display this message", Help); 649 | NewProcedure("read", "Read parameters from file", Read); 650 | settings := NewAssoc("set", "Define a macro parameter", FALSE); 651 | END arConfiguration. 652 | -------------------------------------------------------------------------------- /src/aria/arDir.ob2: -------------------------------------------------------------------------------- 1 | MODULE arDir; 2 | 3 | IMPORT 4 | C := arC, 5 | SYSTEM, 6 | arCString; 7 | 8 | TYPE 9 | DIR = SYSTEM.ADRINT; 10 | DIRENT = SYSTEM.ADRINT; 11 | 12 | FileFinder* = RECORD 13 | dir : DIR; 14 | ent : DIRENT; 15 | END; 16 | 17 | 18 | PROCEDURE -AAincludeDirent* "#include "; 19 | PROCEDURE -opendir(name : ARRAY OF CHAR) : DIR "(SYSTEM_ADRINT) opendir(name)"; 20 | PROCEDURE -closedir(dir : DIR) "closedir((DIR*) dir)"; 21 | PROCEDURE -readdir(dir : DIR) : DIRENT "(SYSTEM_ADRINT) readdir((DIR*) dir)"; 22 | PROCEDURE -getdirname(ent : DIRENT) : C.string "(((struct dirent *) ent) -> d_name)"; 23 | PROCEDURE -getdirtype(ent : DIRENT) : C.int "(int)((struct dirent *) ent) -> d_type)"; 24 | PROCEDURE -typeDir "DT_DIR"; 25 | PROCEDURE -typeReg "DT_REG"; 26 | PROCEDURE -typeLink "DT_LNK"; 27 | 28 | PROCEDURE (VAR f : FileFinder) Open*(path-: ARRAY OF CHAR) : BOOLEAN; 29 | (* Start enumerating files in directory *) 30 | BEGIN 31 | f.dir := opendir(path); 32 | RETURN f.dir # 0; 33 | END Open; 34 | 35 | PROCEDURE (VAR f : FileFinder) Next*(VAR name : ARRAY OF CHAR) : BOOLEAN; 36 | (* Find the next file in directory. Return FALSE when no more are available *) 37 | BEGIN 38 | ASSERT(f.dir # 0); 39 | f.ent := readdir(f.dir); 40 | IF f.ent = 0 THEN 41 | RETURN FALSE; 42 | END; 43 | arCString.CopyToArray(getdirname(f.ent), name); 44 | RETURN TRUE; 45 | END Next; 46 | 47 | PROCEDURE (VAR f : FileFinder) Close*; 48 | (* Stop enumerating files. MUST BE CALLED to avoid leaking C directory streams *) 49 | BEGIN 50 | IF f.dir # 0 THEN 51 | closedir(f.dir); 52 | END; 53 | END Close; 54 | 55 | END arDir. 56 | -------------------------------------------------------------------------------- /src/aria/arErr.ob2: -------------------------------------------------------------------------------- 1 | MODULE arErr; 2 | 3 | IMPORT 4 | arText, 5 | arFile; 6 | 7 | VAR 8 | writer : arText.StreamWriter; 9 | 10 | PROCEDURE String*(text-: ARRAY OF CHAR); 11 | BEGIN 12 | writer.String(text); 13 | END String; 14 | 15 | PROCEDURE Int*(value : LONGINT); 16 | BEGIN 17 | writer.Integer(value); 18 | END Int; 19 | 20 | PROCEDURE Hex*(value : LONGINT); 21 | BEGIN 22 | writer.Hex(value); 23 | END Hex; 24 | 25 | PROCEDURE Char*(value : CHAR); 26 | BEGIN 27 | writer.Char(value); 28 | END Char; 29 | 30 | PROCEDURE Real*(value : LONGREAL); 31 | BEGIN 32 | writer.Real(value); 33 | END Real; 34 | 35 | PROCEDURE Ln*; 36 | BEGIN 37 | writer.Ln; 38 | END Ln; 39 | 40 | PROCEDURE Flush*; 41 | BEGIN 42 | writer.Flush; 43 | END Flush; 44 | 45 | PROCEDURE Bool*(value : BOOLEAN); 46 | BEGIN 47 | writer.Boolean(value); 48 | END Bool; 49 | 50 | BEGIN 51 | writer.Init(arFile.err.GetStream()); 52 | END arErr. 53 | -------------------------------------------------------------------------------- /src/aria/arFile.ob2: -------------------------------------------------------------------------------- 1 | MODULE arFile; 2 | 3 | IMPORT 4 | C := arC, 5 | Text := arText, 6 | SYSTEM; 7 | 8 | CONST 9 | seekSet* = 0; 10 | seekCur* = 1; 11 | seekEnd* = 2; 12 | 13 | TYPE 14 | FILE* = POINTER [untagged] TO RECORD [untagged] END; 15 | 16 | FilePos* = SYSTEM.INT64; 17 | 18 | StreamPtr* = POINTER TO Stream; 19 | Stream* = RECORD (Text.Stream) 20 | file : FILE; 21 | END; 22 | 23 | File* = POINTER TO RECORD 24 | file : FILE; 25 | success- : BOOLEAN; 26 | END; 27 | 28 | VAR 29 | out* : File; (* standard output *) 30 | err* : File; (* standard error *) 31 | 32 | PROCEDURE -AAincludeStdio* "#include "; 33 | PROCEDURE -AAincludeErrno* "#include "; 34 | PROCEDURE -getStdOut() : FILE "(arFile_FILE) stdout"; 35 | PROCEDURE -getStdErr() : FILE "(arFile_FILE) stderr"; 36 | 37 | PROCEDURE -fclose*(file : FILE) : C.int "fclose((FILE *)file)"; 38 | PROCEDURE -feof*(file : FILE) : C.int "feof((FILE *)file)"; 39 | PROCEDURE -fflush(file : FILE) : C.int "fflush((FILE *)file)"; 40 | PROCEDURE -fopen*(name, mode : ARRAY OF CHAR) : FILE 41 | "(arFile_FILE) fopen((const char *)name, (const char *)mode)"; 42 | PROCEDURE -fputc(file : FILE; ch : CHAR) : C.int "fputc(ch,(FILE *)file)"; 43 | PROCEDURE -fputs(file : FILE; str : ARRAY OF CHAR) : C.int "fputs((const char *)str,(FILE *)file)"; 44 | PROCEDURE -fseek*(file : FILE; offset : C.longint; whence : C.int) : C.int "fseek((FILE *)file, offset, whence)"; 45 | PROCEDURE -ftell(file : FILE) : C.longint "ftell((FILE *)file)"; 46 | PROCEDURE -errno() : C.int "errno"; 47 | 48 | (* ------ Stream ------ *) 49 | 50 | PROCEDURE (VAR self : Stream) Char*(value : CHAR); 51 | VAR result : C.int; 52 | BEGIN 53 | result := fputc(self.file, value); 54 | END Char; 55 | 56 | PROCEDURE (VAR self : Stream) String*(value-: ARRAY OF CHAR); 57 | VAR result : C.int; 58 | BEGIN 59 | result := fputs(self.file, value); 60 | END String; 61 | 62 | PROCEDURE (VAR self : Stream) Flush*; 63 | VAR result : C.int; 64 | BEGIN 65 | result := fflush(self.file); 66 | END Flush; 67 | 68 | PROCEDURE NewStream(file : FILE) : StreamPtr; 69 | VAR s : StreamPtr; 70 | BEGIN 71 | NEW(s); s.file := file; 72 | RETURN s; 73 | END NewStream; 74 | 75 | (* ------ File ------ *) 76 | 77 | PROCEDURE (self : File) Init(file : FILE); 78 | BEGIN 79 | self.file := file; 80 | self.success := TRUE; 81 | END Init; 82 | 83 | PROCEDURE (self : File) Close*; 84 | BEGIN 85 | self.success := fclose(self.file) = 0; 86 | END Close; 87 | 88 | PROCEDURE (self : File) Flush; 89 | BEGIN 90 | self.success := fflush(self.file) = 0; 91 | END Flush; 92 | 93 | PROCEDURE (self : File) Seek*(offset : C.longint; whence : C.int) : C.int; 94 | BEGIN 95 | self.success := fseek(self.file, offset, whence) = 0; 96 | END Seek; 97 | 98 | PROCEDURE (self : File) Tell*() : C.longint; 99 | VAR result : C.longint; 100 | BEGIN 101 | result := ftell(self.file); 102 | self.success := result >= 0; 103 | END Tell; 104 | 105 | PROCEDURE (self : File) PutC*(ch : CHAR); 106 | BEGIN 107 | self.success := fputc(self.file, ch) = 0; 108 | END PutC; 109 | 110 | PROCEDURE (self : File) PutS*(str : ARRAY OF CHAR) : C.int; 111 | BEGIN 112 | self.success := fputs(self.file, str) = 0; 113 | END PutS; 114 | 115 | PROCEDURE (self : File) EOF*() : BOOLEAN; 116 | BEGIN 117 | RETURN feof(self.file) # 0; 118 | END EOF; 119 | 120 | PROCEDURE (self : File) Error() : C.int; 121 | BEGIN 122 | RETURN errno(); 123 | END Error; 124 | 125 | PROCEDURE NewFile(f : FILE) : File; 126 | VAR file : File; 127 | BEGIN 128 | NEW(file); 129 | file.file := f; 130 | RETURN file; 131 | END NewFile; 132 | 133 | PROCEDURE (self : File) GetStream*() : StreamPtr; 134 | BEGIN 135 | RETURN NewStream(self.file); 136 | END GetStream; 137 | 138 | PROCEDURE Open*(name, mode : ARRAY OF CHAR) : File; 139 | VAR 140 | f : FILE; 141 | file : File; 142 | BEGIN 143 | f := fopen(name, mode); 144 | IF f = NIL THEN RETURN NIL END; 145 | RETURN NewFile(f); 146 | END Open; 147 | 148 | BEGIN 149 | out := NewFile(getStdOut()); 150 | err := NewFile(getStdErr()); 151 | END arFile. 152 | 153 | -------------------------------------------------------------------------------- /src/aria/arFormat.ob2: -------------------------------------------------------------------------------- 1 | 2 | (* This module attempts some basic Formatting in the spirit of printf. We don't 3 | have variable argument lists, so there are families of function for specific 4 | numbers of parameters. Arguments are of type Value.Object, so primitive types 5 | must be boxed like so: 6 | 7 | Out3("{} plus {} equals {}\n", V.int(x), V.int(y), V.int(x+y)); 8 | 9 | Use OutN to print a Formatted string with N paramters. 10 | 11 | The corresponding FormatN functions return a Formatted Value.String. For example: 12 | 13 | text := Format2("Moved to position ({}, {})\n", V.real(x), V.real(y)); 14 | 15 | For Value.Real and Value.Integer, standard printf Formatting options are 16 | supported. Don't include the '%' as this is added automatically. For example: 17 | 18 | Out3("MIDI: {02x} {02x} {02x}\n", V.int(status), V.int(data1), V.int(data2)); 19 | 20 | *) 21 | 22 | MODULE arFormat; 23 | 24 | IMPORT 25 | SYSTEM, 26 | arStream, 27 | V := arValue, 28 | 29 | CFormat := arCFormat, 30 | S := arStrings, 31 | Text := arText; 32 | 33 | (* Handle conversion options. is an option string of length . 34 | THe string representation of will be stored in , returning TRUE on 35 | success. *) 36 | 37 | PROCEDURE ConvertOption(VAR options: ARRAY OF CHAR; oPos : INTEGER; VAR output : ARRAY OF CHAR; o : V.Object) : BOOLEAN; 38 | VAR type : CHAR; 39 | BEGIN 40 | IF o = NIL THEN RETURN FALSE END; 41 | CASE options[oPos-1] OF 42 | | 'd', 'i', 'u', 'x', 'c': 43 | WITH o : V.Integer DO 44 | CFormat.IntToString(output, options, o.value); RETURN TRUE; 45 | ELSE 46 | END 47 | | 'e', 'f', 'g': 48 | WITH o : V.Real DO 49 | CFormat.RealToString(output, options, o.value); RETURN TRUE; 50 | ELSE 51 | END 52 | | 's' : 53 | WITH o : V.String DO 54 | CFormat.StringToString(output, options, o.value^); RETURN TRUE; 55 | ELSE 56 | END 57 | ELSE 58 | END; 59 | RETURN FALSE; 60 | END ConvertOption; 61 | 62 | (* Format with arguments stored in ARRAY OF V.Object. For fixed argument 63 | lengths, this will be allocated on the stack *) 64 | 65 | PROCEDURE Format*(VAR w : Text.Writer; fmt : ARRAY OF CHAR; VAR args : ARRAY OF V.Object); 66 | VAR 67 | i, arg : LONGINT; ch : CHAR; 68 | inFormat : BOOLEAN; 69 | options : ARRAY 32 OF CHAR; 70 | conversion : ARRAY 32 OF CHAR; 71 | oPos : INTEGER; 72 | o : V.Object; 73 | type : CHAR; 74 | BEGIN 75 | i := 0; arg := 0; 76 | inFormat := FALSE; 77 | WHILE (i < LEN(fmt)) & (fmt[i] # 0X) DO 78 | ch := fmt[i]; INC(i); 79 | IF inFormat THEN 80 | IF ch = '}' THEN 81 | inFormat := FALSE; 82 | IF arg < LEN(args) THEN 83 | o := args[arg]; INC(arg); 84 | (* if options specified, try a specific conversion *) 85 | IF (oPos > 0) & ConvertOption(options, oPos, conversion, o) THEN 86 | w.String(conversion); 87 | ELSE 88 | (* otherwise, use default conversion to string *) 89 | V.Format(w, o); 90 | END; 91 | END 92 | ELSE 93 | IF oPos < LEN(options)-1 THEN 94 | options[oPos] := ch; INC(oPos); 95 | options[oPos] := 0X; 96 | END; 97 | END 98 | ELSE 99 | CASE ch OF 100 | | '{': 101 | inFormat := TRUE; 102 | options[0] := '%'; 103 | options[1] := 0X; 104 | oPos := 1; 105 | | '\': 106 | IF i < LEN(fmt) THEN 107 | ch := fmt[i]; 108 | CASE ch OF 109 | | 'a': ch := 07X; 110 | | 'b': ch := 08X; 111 | | 't': ch := 09X; 112 | | 'n': ch := 0AX; 113 | | 'r': ch := 0DX; 114 | ELSE 115 | END; 116 | INC(i); w.Char(ch); 117 | END 118 | ELSE 119 | w.Char(ch); 120 | END; 121 | END 122 | END; 123 | END Format; 124 | 125 | PROCEDURE FormatString*(VAR fmt : ARRAY OF CHAR; VAR args : ARRAY OF V.Object) : V.String; 126 | VAR result : Text.Buffer; 127 | BEGIN 128 | result.Init(32); 129 | Format(result, fmt, args); 130 | RETURN V.strb(result); 131 | END FormatString; 132 | 133 | PROCEDURE Format0*(fmt : ARRAY OF CHAR) : V.String; 134 | VAR args : ARRAY 1 OF V.Object; 135 | BEGIN 136 | args[0] := NIL; 137 | RETURN FormatString(fmt, args); 138 | END Format0; 139 | 140 | PROCEDURE Format1*(fmt : ARRAY OF CHAR; p1 : V.Object) : V.String; 141 | VAR args : ARRAY 1 OF V.Object; 142 | BEGIN 143 | args[0] := p1; 144 | RETURN FormatString(fmt, args); 145 | END Format1; 146 | 147 | PROCEDURE Format2*(fmt : ARRAY OF CHAR; p1, p2 : V.Object) : V.String; 148 | VAR args : ARRAY 2 OF V.Object; 149 | BEGIN 150 | args[0] := p1; args[1] := p2; 151 | RETURN FormatString(fmt, args); 152 | END Format2; 153 | 154 | PROCEDURE Format3*(fmt : ARRAY OF CHAR; p1, p2, p3 : V.Object) : V.String; 155 | VAR args : ARRAY 3 OF V.Object; 156 | BEGIN 157 | args[0] := p1; args[1] := p2; args[2] := p3; 158 | RETURN FormatString(fmt, args); 159 | END Format3; 160 | 161 | PROCEDURE Format4*(fmt : ARRAY OF CHAR; p1, p2, p3, p4 : V.Object) : V.String; 162 | VAR args : ARRAY 4 OF V.Object; 163 | BEGIN 164 | args[0] := p1; args[1] := p2; args[2] := p3; args[3] := p4; 165 | RETURN FormatString(fmt, args); 166 | END Format4; 167 | 168 | PROCEDURE Format5*(fmt : ARRAY OF CHAR; p1, p2, p3, p4, p5 : V.Object) : V.String; 169 | VAR args : ARRAY 5 OF V.Object; 170 | BEGIN 171 | args[0] := p1; args[1] := p2; args[2] := p3; args[3] := p4; args[4] := p5; 172 | RETURN FormatString(fmt, args); 173 | END Format5; 174 | 175 | (* Format with arguments stored in Value.List *) 176 | 177 | PROCEDURE FormatList*(w : Text.Writer; fmt : ARRAY OF CHAR; args : V.List); 178 | VAR 179 | argsArray : V.ObjectArray; 180 | BEGIN 181 | argsArray := args.ToObjectArray(); 182 | Format(w, fmt, argsArray^); 183 | END FormatList; 184 | 185 | (* Out0 .. Out5 output Formatted messages with fixed number of paramters *) 186 | 187 | PROCEDURE Out0*(fmt : ARRAY OF CHAR); 188 | VAR args : ARRAY 1 OF V.Object; 189 | BEGIN 190 | args[0] := NIL; 191 | Format(arStream.out, fmt, args); 192 | END Out0; 193 | 194 | PROCEDURE Out1*(fmt : ARRAY OF CHAR; p1 : V.Object); 195 | VAR args : ARRAY 1 OF V.Object; 196 | BEGIN 197 | args[0] := p1; 198 | Format(arStream.out, fmt, args); 199 | END Out1; 200 | 201 | PROCEDURE Out2*(fmt : ARRAY OF CHAR; p1, p2 : V.Object); 202 | VAR args : ARRAY 2 OF V.Object; 203 | BEGIN 204 | args[0] := p1; args[1] := p2; 205 | Format(arStream.out, fmt, args); 206 | END Out2; 207 | 208 | PROCEDURE Out3*(fmt : ARRAY OF CHAR; p1, p2, p3 : V.Object); 209 | VAR args : ARRAY 3 OF V.Object; 210 | BEGIN 211 | args[0] := p1; args[1] := p2; args[2] := p3; 212 | Format(arStream.out, fmt, args); 213 | END Out3; 214 | 215 | PROCEDURE Out4*(fmt : ARRAY OF CHAR; p1, p2, p3, p4 : V.Object); 216 | VAR args : ARRAY 4 OF V.Object; 217 | BEGIN 218 | args[0] := p1; args[1] := p2; args[2] := p3; args[3] := p4; 219 | Format(arStream.out, fmt, args); 220 | END Out4; 221 | 222 | PROCEDURE Out5*(fmt : ARRAY OF CHAR; p1, p2, p3, p4, p5 : V.Object); 223 | VAR args : ARRAY 5 OF V.Object; 224 | BEGIN 225 | args[0] := p1; args[1] := p2; args[2] := p3; args[3] := p4; args[4] := p5; 226 | Format(arStream.out, fmt, args); 227 | END Out5; 228 | 229 | (* Equivalent to Out1("{}", o) *) 230 | 231 | PROCEDURE Show*(o : V.Object); 232 | BEGIN 233 | V.Format(arStream.out, o); 234 | END Show; 235 | 236 | PROCEDURE ShowLn*(o : V.Object); 237 | BEGIN 238 | V.Format(arStream.out, o); 239 | arStream.out.Ln; 240 | END ShowLn; 241 | 242 | END arFormat. 243 | -------------------------------------------------------------------------------- /src/aria/arJSON.ob2: -------------------------------------------------------------------------------- 1 | (* JSON parser *) 2 | 3 | MODULE arJSON; 4 | 5 | IMPORT 6 | Files, 7 | String := arStrings, 8 | 9 | Out := arOut, 10 | Text := arText, 11 | V := arValue; 12 | 13 | CONST 14 | optComments* = 0; 15 | optRelaxKeys* = 1; 16 | optJS* = {optComments, optRelaxKeys}; 17 | optDebug* = 2; 18 | 19 | (* 20 | 1 - Unexpected character in value 21 | 2 - String quote expected 22 | 3 - Invalid control character in string 23 | 4 - Unknown escape character in string 24 | 5 - Invalid number format : failed to parse 25 | 6 - Undefined identifier 26 | 7 - Expected character not found 27 | *) 28 | 29 | PROCEDURE ParseJSON* (text-: ARRAY OF CHAR; VAR err : LONGINT; features : SET) : V.Object; 30 | CONST 31 | CR=0DX; LF=0AX; TAB=09X; SPACE=20X; FF=0CX; BS=08X; 32 | VAR 33 | pos, length : LONGINT; 34 | ch : CHAR; 35 | 36 | (* get next character into ch, setting 0X when complete *) 37 | PROCEDURE next0; 38 | BEGIN 39 | IF pos < length THEN 40 | ch := text[pos]; INC(pos); 41 | ELSE 42 | ch := 0X; 43 | END; 44 | IF optDebug IN features THEN 45 | Out.Char(ch); 46 | END; 47 | END next0; 48 | 49 | PROCEDURE skipSpace0; 50 | BEGIN 51 | WHILE (ch=CR) OR (ch=LF) OR (ch=TAB) OR (ch=SPACE) DO 52 | next0 53 | END 54 | END skipSpace0; 55 | 56 | PROCEDURE skipSpace; 57 | VAR chLast, chSafe : CHAR; posSafe : LONGINT; 58 | BEGIN 59 | skipSpace0; 60 | LOOP 61 | IF (ch#'/') OR ~(optComments IN features) THEN EXIT END; 62 | chSafe := ch; posSafe := pos; 63 | next0; (* lookahead *) 64 | IF ch='/' THEN 65 | (* javascript comment until end of line *) 66 | next0; 67 | WHILE (ch # LF) & (ch # 0X) DO 68 | next0; 69 | END; 70 | skipSpace0; 71 | ELSIF ch='*' THEN 72 | (* javascript comment until closing '*/' *) 73 | next0; 74 | chLast := 0X; 75 | LOOP 76 | IF (ch=0X) OR ((ch='/') & (chLast='*')) THEN EXIT END; 77 | chLast := ch; 78 | next0; 79 | END; 80 | next0; 81 | skipSpace0; 82 | ELSE 83 | ch := chSafe; pos := posSafe; (* hack! restore lookahed *) 84 | EXIT; 85 | END 86 | END; 87 | END skipSpace; 88 | 89 | (* get next character, bypassing any space *) 90 | PROCEDURE next; 91 | BEGIN 92 | next0; 93 | skipSpace; 94 | END next; 95 | 96 | PROCEDURE error(code : LONGINT); 97 | BEGIN 98 | Out.String("Error: "); Out.Int(code); 99 | Out.String(" at position "); Out.Int(pos); 100 | Out.Ln; 101 | err := code; 102 | END error; 103 | 104 | PROCEDURE consume(expect : CHAR); 105 | BEGIN 106 | IF ch = expect THEN next 107 | ELSE 108 | Out.String("Error: Expected '"); Out.Char(expect); 109 | Out.String("' but found '"); Out.Char(ch); 110 | Out.String("' at position "); Out.Int(pos); 111 | Out.Ln; 112 | err := 7; 113 | END; 114 | END consume; 115 | 116 | PROCEDURE ^parseValue() : V.Object; 117 | 118 | PROCEDURE parseString() : V.String; 119 | VAR buffer : Text.Buffer; 120 | BEGIN 121 | buffer.Init(16); 122 | IF ch # '"' THEN 123 | error(2); 124 | ELSE 125 | next0; 126 | LOOP 127 | IF ch = '"' THEN EXIT 128 | ELSIF ch < SPACE THEN error(3); EXIT 129 | ELSIF ch = '\' THEN 130 | next0; 131 | CASE ch OF 132 | | '"', '\', '/': (* literal value *) 133 | | 'b': ch := BS 134 | | 'f': ch := FF 135 | | 'n': ch := LF 136 | | 'r': ch := CR 137 | | 't': ch := TAB 138 | ELSE 139 | error(4); 140 | END; 141 | END; 142 | buffer.Char(ch); next0; 143 | END; 144 | next; 145 | END; 146 | RETURN V.strb(buffer); 147 | END parseString; 148 | 149 | PROCEDURE parseNumber() : V.Object; 150 | VAR 151 | negate, isReal : BOOLEAN; 152 | buffer : Text.Buffer; 153 | result : V.Object; 154 | 155 | PROCEDURE digits(); 156 | BEGIN 157 | WHILE (ch >= '0') & (ch <= '9') DO 158 | buffer.Char(ch); next0; 159 | END; 160 | END digits; 161 | BEGIN 162 | buffer.Init(32); 163 | negate := ch = '-'; 164 | IF negate THEN buffer.Char(ch); next0 END; 165 | digits(); 166 | isReal := FALSE; 167 | IF ch = '.' THEN 168 | isReal := TRUE; 169 | buffer.Char(ch); next0; 170 | digits(); 171 | END; 172 | IF (ch = 'E') OR (ch = 'e') THEN 173 | isReal := TRUE; 174 | buffer.Char('E'); next0; 175 | IF (ch = '-') OR (ch = '+') THEN 176 | buffer.Char(ch); next0; 177 | END; 178 | digits(); 179 | END; 180 | skipSpace; 181 | buffer.Terminate(); 182 | IF isReal THEN 183 | result := V.ParseReal(buffer.value^); 184 | ELSE 185 | result := V.ParseInt(buffer.value^); 186 | END; 187 | IF result = NIL THEN 188 | error(5); RETURN V.strb(buffer); 189 | END; 190 | RETURN result 191 | END parseNumber; 192 | 193 | PROCEDURE isAlpha(ch : CHAR) : BOOLEAN; 194 | BEGIN 195 | RETURN ((ch >= 'a') & (ch <= 'z')) OR ((ch >='A') & (ch <= 'Z')) 196 | END isAlpha; 197 | 198 | PROCEDURE getIdent() : V.String; 199 | VAR buffer : Text.Buffer; 200 | BEGIN 201 | buffer.Init(32); 202 | WHILE isAlpha(ch) DO 203 | buffer.Char(ch); next0; 204 | END; 205 | skipSpace; 206 | RETURN V.strb(buffer); 207 | END getIdent; 208 | 209 | PROCEDURE parseIdent() : V.Object; 210 | VAR i : V.String; 211 | BEGIN 212 | i := getIdent(); 213 | IF i.value^ = "true" THEN 214 | RETURN V.bool(TRUE); 215 | ELSIF i.value^ = "false" THEN 216 | RETURN V.bool(FALSE); 217 | END; 218 | error(6); RETURN i; 219 | END parseIdent; 220 | 221 | PROCEDURE parseObject() : V.Record; 222 | VAR r : V.Record; 223 | PROCEDURE keyValue(); 224 | VAR key : V.String; value : V.Object; 225 | BEGIN 226 | IF (optRelaxKeys IN features) & isAlpha(ch) THEN 227 | key := getIdent() 228 | ELSE 229 | key := parseString(); 230 | END; 231 | consume(':'); 232 | value := parseValue(); 233 | r.Set(key.value^, value); 234 | END keyValue; 235 | BEGIN 236 | next; 237 | r := V.record(); 238 | IF ch # '}' THEN 239 | keyValue; 240 | WHILE ch = ',' DO 241 | next; 242 | keyValue; 243 | END 244 | END; 245 | consume('}'); 246 | RETURN r; 247 | END parseObject; 248 | 249 | PROCEDURE parseList() : V.List; 250 | VAR l : V.List; 251 | BEGIN 252 | next; 253 | l := V.list(); 254 | IF ch # ']' THEN 255 | l.Append(parseValue()); 256 | WHILE ch = ',' DO 257 | next; 258 | l.Append(parseValue()); 259 | END; 260 | END; 261 | consume(']'); 262 | RETURN l; 263 | END parseList; 264 | 265 | PROCEDURE parseValue() : V.Object; 266 | BEGIN 267 | IF isAlpha(ch) THEN RETURN parseIdent() END; 268 | CASE ch OF 269 | | '{' : RETURN parseObject(); 270 | | '[' : RETURN parseList(); 271 | | '"' : RETURN parseString(); 272 | | '0'..'9', '-': RETURN parseNumber(); 273 | ELSE 274 | error(1); RETURN NIL; 275 | END 276 | END parseValue; 277 | 278 | BEGIN 279 | length := String.Length(text); 280 | pos := 0; 281 | next; 282 | err := 0; 283 | RETURN parseValue(); 284 | END ParseJSON; 285 | 286 | PROCEDURE ReadFile*(name-: ARRAY OF CHAR) : V.String; 287 | VAR 288 | ch : CHAR; 289 | f : Files.File; 290 | r : Files.Rider; 291 | s : Text.Buffer; 292 | BEGIN 293 | f := Files.Old(name); 294 | IF f = NIL THEN RETURN NIL END; 295 | Files.Set(r, f, 0); 296 | s.Init(128); 297 | LOOP 298 | Files.ReadChar(r, ch); 299 | IF ch = 0X THEN 300 | Files.Close(f); 301 | RETURN V.strb(s) 302 | END; 303 | s.Char(ch); 304 | END 305 | END ReadFile; 306 | 307 | PROCEDURE ParseString*(text : ARRAY OF CHAR) : V.Object; 308 | VAR result : V.Object; res : LONGINT; 309 | BEGIN 310 | result := ParseJSON(text, res, optJS); 311 | IF res # 0 THEN RETURN NIL END; 312 | RETURN result; 313 | END ParseString; 314 | 315 | PROCEDURE ReadJSON*(name-: ARRAY OF CHAR) : V.Object; 316 | VAR text : V.String; 317 | BEGIN 318 | text := ReadFile(name); 319 | IF text = NIL THEN RETURN NIL END; 320 | RETURN ParseString(text.value^); 321 | END ReadJSON; 322 | 323 | END arJSON. 324 | -------------------------------------------------------------------------------- /src/aria/arMath.ob2: -------------------------------------------------------------------------------- 1 | (* Fast Math using math.h *) 2 | 3 | MODULE arMath; 4 | 5 | (* OMAKE LINK "m" *) 6 | 7 | IMPORT 8 | SYSTEM, 9 | C := arC; 10 | 11 | CONST 12 | PI* = 3.14159265358979323846264338327950288; 13 | E* = 2.71828182845904523536028747135266250; 14 | 15 | PROCEDURE -includeMath* "#include "; 16 | 17 | PROCEDURE -sin*(x : C.double) : C.double "sin((double)x)"; 18 | PROCEDURE -cos*(x : C.double) : C.double "cos((double)x)"; 19 | PROCEDURE -tan*(x : C.double) : C.double "tan((double)x)"; 20 | PROCEDURE -sinh*(x : C.double) : C.double "sinh((double)x)"; 21 | PROCEDURE -cosh*(x : C.double) : C.double "cosh((double)x)"; 22 | PROCEDURE -tanh*(x : C.double) : C.double "tanh((double)x)"; 23 | 24 | PROCEDURE -exp*(x : C.double) : C.double "exp((double)x)"; 25 | PROCEDURE -log*(x : C.double) : C.double "log((double)x)"; 26 | PROCEDURE -log2*(x : C.double) : C.double "log2((double)x)"; 27 | PROCEDURE -log10*(x : C.double) : C.double "log10((double)x)"; 28 | PROCEDURE -pow*(x, y : C.double) : C.double "pow((double)x, (double)y)"; 29 | PROCEDURE -fmod*(x, y : C.double) : C.double "fmod((double)x, (double)y)"; 30 | 31 | PROCEDURE -fabs*(x : C.double) : C.double "fabs((double)x)"; 32 | PROCEDURE -sqrt*(x : C.double) : C.double "sqrt((double)x)"; 33 | PROCEDURE -ceil*(x : C.double) : C.double "ceil((double)x)"; 34 | PROCEDURE -floor*(x : C.double) : C.double "floor((double)x)"; 35 | PROCEDURE -round*(x : C.double) : C.double "round((double)x)"; 36 | PROCEDURE -int*(x : C.double) : C.int "(int)(x)"; 37 | PROCEDURE -modf*(x : C.double; VAR i : C.double) : C.double "modf(x, i)"; 38 | 39 | PROCEDURE -sinf*(x : C.float) : C.float "sinf((float)x)"; 40 | PROCEDURE -cosf*(x : C.float) : C.float "cosf((float)x)"; 41 | PROCEDURE -tanf*(x : C.float) : C.float "tanf((float)x)"; 42 | PROCEDURE -sinhf*(x : C.float) : C.float "sinhf((float)x)"; 43 | PROCEDURE -coshf*(x : C.float) : C.float "coshf((float)x)"; 44 | PROCEDURE -tanhf*(x : C.float) : C.float "tanhf((float)x)"; 45 | 46 | PROCEDURE -expf*(x : C.float) : C.float "expf((float)x)"; 47 | PROCEDURE -logf*(x : C.float) : C.float "logf((float)x)"; 48 | PROCEDURE -log2f*(x : C.float) : C.float "log2f((float)x)"; 49 | PROCEDURE -log10f*(x : C.float) : C.float "log10f((float)x)"; 50 | PROCEDURE -powf*(x, y : C.float) : C.float "powf((float)x, (float)y)"; 51 | 52 | PROCEDURE -fabsf*(x : C.float) : C.float "fabsf((float)x)"; 53 | PROCEDURE -sqrtf*(x : C.float) : C.float "sqrtf((float)x)"; 54 | PROCEDURE -ceilf*(x : C.float) : C.float "ceilf((float)x)"; 55 | PROCEDURE -floorf*(x : C.float) : C.float "floorf((float)x)"; 56 | PROCEDURE -roundf*(x : C.float) : C.float "roundf((float)x)"; 57 | PROCEDURE -fmodf*(x, y : C.float) : C.float "fmod((float)x, (float)y)"; 58 | 59 | END arMath. 60 | -------------------------------------------------------------------------------- /src/aria/arOut.ob2: -------------------------------------------------------------------------------- 1 | MODULE arOut; 2 | 3 | IMPORT 4 | arText, 5 | arFile; 6 | 7 | VAR 8 | writer : arText.StreamWriter; 9 | 10 | PROCEDURE String*(text-: ARRAY OF CHAR); 11 | BEGIN 12 | writer.String(text); 13 | END String; 14 | 15 | PROCEDURE Int*(value : LONGINT); 16 | BEGIN 17 | writer.Integer(value); 18 | END Int; 19 | 20 | PROCEDURE Hex*(value : LONGINT); 21 | BEGIN 22 | writer.Hex(value); 23 | END Hex; 24 | 25 | PROCEDURE Set*(value : SET); 26 | BEGIN 27 | writer.Set(value); 28 | END Set; 29 | 30 | PROCEDURE Char*(value : CHAR); 31 | BEGIN 32 | writer.Char(value); 33 | END Char; 34 | 35 | PROCEDURE Real*(value : LONGREAL); 36 | BEGIN 37 | writer.Real(value); 38 | END Real; 39 | 40 | PROCEDURE Ln*; 41 | BEGIN 42 | writer.Ln; 43 | END Ln; 44 | 45 | PROCEDURE Flush*; 46 | BEGIN 47 | writer.Flush; 48 | END Flush; 49 | 50 | PROCEDURE Bool*(value : BOOLEAN); 51 | BEGIN 52 | writer.Boolean(value); 53 | END Bool; 54 | 55 | BEGIN 56 | writer.Init(arFile.out.GetStream()); 57 | END arOut. 58 | -------------------------------------------------------------------------------- /src/aria/arPath.ob2: -------------------------------------------------------------------------------- 1 | (* Functions for manipulating file paths *) 2 | 3 | MODULE arPath; 4 | 5 | IMPORT 6 | Out := arOut, 7 | Strings := arStrings; 8 | 9 | CONST 10 | separator = '/'; 11 | 12 | PROCEDURE DirName*(path-: ARRAY OF CHAR; VAR dir : ARRAY OF CHAR); 13 | VAR index : Strings.LengthType; 14 | BEGIN 15 | index := Strings.LastIndexOf(path, separator, -1); 16 | IF index >= 0 THEN 17 | Strings.Extract(path, 0, index, dir); 18 | ELSE 19 | dir[0] := 0X; 20 | END; 21 | END DirName; 22 | 23 | PROCEDURE BaseName*(path-: ARRAY OF CHAR; VAR base : ARRAY OF CHAR); 24 | VAR index : Strings.LengthType; 25 | BEGIN 26 | index := Strings.LastIndexOf(path, separator, -1); 27 | IF index >= 0 THEN 28 | Strings.Extract(path, index+1, LEN(base), base); 29 | ELSE 30 | Strings.Assign(path, base); 31 | END; 32 | END BaseName; 33 | 34 | PROCEDURE ExtName*(path-: ARRAY OF CHAR; VAR ext : ARRAY OF CHAR); 35 | VAR index : Strings.LengthType; 36 | BEGIN 37 | index := Strings.LastIndexOf(path, ".", -1); 38 | IF (index >= 0) & (Strings.IndexOf(path, separator, index)<0) THEN 39 | Strings.Extract(path, index, LEN(ext), ext); 40 | ELSE 41 | ext[0] := 0X; 42 | END; 43 | END ExtName; 44 | 45 | END arPath. 46 | -------------------------------------------------------------------------------- /src/aria/arPattern.ob2: -------------------------------------------------------------------------------- 1 | (* Assorted string manipulation functions *) 2 | 3 | (* SG 2020/08/27 *) 4 | 5 | MODULE arPattern; 6 | 7 | IMPORT 8 | Platform, 9 | Out := arOut, 10 | Char := arChar, 11 | SL := arStringList, 12 | SA := arStringAssoc, 13 | Text := arText, 14 | S := arStrings; 15 | 16 | TYPE 17 | String* = SL.String; 18 | StringArray* = SL.Array; 19 | 20 | (* Match - A very simple pattern matcher. 21 | 22 | The string is matched against the string. 23 | Corresponding characters must match, except: 24 | ' ' matches any number of ' ' characters 25 | '*' matches all characters until the character following the '*' is found 26 | 27 | Inputs: 28 | pattern: pattern to match 29 | input: input string to be compared with pattern 30 | Outputs: 31 | result: an array of strings, one for each matched "*" field 32 | Returns: 33 | TRUE when matches the 34 | *) 35 | 36 | PROCEDURE Match*(pattern-, input- : ARRAY OF CHAR; VAR result : StringArray) : BOOLEAN; 37 | VAR 38 | i : LONGINT; 39 | 40 | patPos, patLength : LONGINT; 41 | patChar : CHAR; 42 | 43 | inPos, inLength : LONGINT; 44 | ch : CHAR; 45 | 46 | terminator : CHAR; 47 | outPos : LONGINT; 48 | buffer : POINTER TO ARRAY OF CHAR; 49 | fields : LONGINT; 50 | match : LONGINT; 51 | 52 | PROCEDURE Next; 53 | BEGIN 54 | IF inPos < inLength THEN 55 | ch := input[inPos]; 56 | INC(inPos); 57 | ELSE 58 | ch := 0X; 59 | END; 60 | END Next; 61 | 62 | BEGIN 63 | patPos := 0; patLength := S.Length(pattern); 64 | inPos := 0; inLength := S.Length(input); 65 | match := 0; 66 | 67 | (* allocate temporary buffer large enough for any substring of input *) 68 | NEW(buffer, inLength+1); 69 | 70 | (* determine number of output fields, and allocate result array *) 71 | fields := 0; 72 | FOR i := 0 TO patLength-1 DO 73 | IF pattern[i] = '*' THEN 74 | INC(fields) 75 | END 76 | END; 77 | IF fields = 0 THEN 78 | result := NIL; (* can't return an array of zero length *) 79 | ELSE 80 | NEW(result, fields); 81 | FOR i := 0 TO fields-1 DO 82 | result[i] := NIL; 83 | END; 84 | END; 85 | 86 | Next; 87 | WHILE patPos < patLength DO 88 | patChar := pattern[patPos]; 89 | INC(patPos); 90 | 91 | CASE patChar OF 92 | | ' ': 93 | IF ch # ' ' THEN RETURN FALSE END; 94 | WHILE (ch = ' ') OR (ch = 09X) DO Next; END 95 | | '*': 96 | (* scan into buffer until terminator or end of input *) 97 | (* note: if nothing follows '*' terminator will be 0X *) 98 | terminator := pattern[patPos]; 99 | outPos := 0; 100 | WHILE (ch # terminator) & (ch # 0X) DO 101 | buffer[outPos] := ch; 102 | INC(outPos); 103 | Next; 104 | END; 105 | buffer[outPos] := 0X; 106 | (* copy text string into result *) 107 | result[match] := SL.Copy(buffer^); 108 | INC(match); 109 | ELSE 110 | IF ch # patChar THEN RETURN FALSE END; 111 | Next; 112 | END; 113 | END; 114 | RETURN TRUE; 115 | END Match; 116 | 117 | (* split a string into array of strings, based on delimiter *) 118 | 119 | PROCEDURE Split*(string- : ARRAY OF CHAR; delimiter : CHAR) : StringArray; 120 | VAR 121 | result : StringArray; 122 | begin, i, length : S.LengthType; 123 | part, nParts : INTEGER; 124 | 125 | PROCEDURE Append(start, count : S.LengthType); 126 | BEGIN 127 | NEW(result[part], count+1); 128 | S.Extract(string, start, count, result[part]^); 129 | INC(part); 130 | END Append; 131 | 132 | BEGIN 133 | (* decide how many parts in the result *) 134 | length := S.Length(string); 135 | nParts := 1; 136 | FOR i := 0 TO length-1 DO 137 | IF string[i] = delimiter THEN INC(nParts) END; 138 | END; 139 | NEW(result, nParts); 140 | 141 | (* now extract sub-strings between terminators *) 142 | part := 0; 143 | begin := 0; 144 | FOR i := 0 TO length-1 DO 145 | IF string[i] = delimiter THEN 146 | Append(begin, i-begin); 147 | begin := i+1; 148 | END; 149 | END; 150 | IF begin <= length THEN 151 | Append(begin, length-begin); 152 | END; 153 | ASSERT(part = nParts); 154 | RETURN result; 155 | END Split; 156 | 157 | (* Parse a string as a shell-like arguments. Arguments are separated by 158 | whitespace, and may be quoted (eg. if the value is a string containing 159 | spaces). 160 | *) 161 | 162 | PROCEDURE ParseArgs*(string- : ARRAY OF CHAR) : StringArray; 163 | VAR 164 | buffer : Text.Buffer; 165 | list : SL.List; 166 | i : LONGINT; 167 | ch, lastCh : CHAR; 168 | inQuote : BOOLEAN; 169 | 170 | PROCEDURE Append; 171 | BEGIN 172 | SL.Add(list, buffer.GetString()); 173 | buffer.Init(buffer.capacity); 174 | END Append; 175 | 176 | BEGIN 177 | buffer.Init(32); 178 | list := NIL; 179 | 180 | lastCh := 0X; 181 | inQuote := FALSE; 182 | FOR i := 0 TO S.Length(string)-1 DO 183 | ch := string[i]; 184 | IF (ch = ' ') & ~inQuote THEN 185 | IF lastCh # ' ' THEN Append; END; 186 | ELSIF ch = '"' THEN 187 | inQuote := ~inQuote; 188 | ELSE 189 | buffer.Char(ch); 190 | END; 191 | lastCh := ch; 192 | END; 193 | Append; 194 | SL.Reverse(list); 195 | RETURN SL.ToArray(list); 196 | END ParseArgs; 197 | 198 | (* Expand environment variables in . *) 199 | PROCEDURE ExpandEnvironmentVariables*(string-: ARRAY OF CHAR) : String; 200 | VAR 201 | i : LONGINT; 202 | ch : CHAR; 203 | outBuffer : Text.Buffer; 204 | keyBuffer : Text.Buffer; key: String; 205 | arg : ARRAY 256 OF CHAR; 206 | BEGIN 207 | i := 0; 208 | outBuffer.Init(32); 209 | keyBuffer.Init(32); 210 | LOOP 211 | IF i >= LEN(string) THEN EXIT END; 212 | ch := string[i]; INC(i); 213 | IF ch = '$' THEN 214 | keyBuffer.Clear; 215 | ch := string[i]; INC(i); 216 | WHILE Char.IsAlphaNumeric(ch) DO 217 | keyBuffer.Char(ch); 218 | ch := string[i]; INC(i); 219 | END; 220 | key := keyBuffer.GetString(); 221 | Platform.GetEnv(key^, arg); 222 | outBuffer.String(arg); 223 | END; 224 | IF ch = 0X THEN EXIT END; 225 | outBuffer.Char(ch); 226 | END; 227 | outBuffer.Terminate; 228 | (* Out.String("Expand '"); Out.String(string); 229 | Out.String("' -> '"); Out.String(outBuffer.value^); 230 | Out.String("'"); Out.Ln; *) 231 | RETURN outBuffer.GetString(); 232 | END ExpandEnvironmentVariables; 233 | 234 | (* Substitute variable names inside {} braces with the corresponding strings in the *) 235 | 236 | PROCEDURE Substitute*(string : ARRAY OF CHAR; environment : SA.Assoc) : String; 237 | VAR 238 | i : LONGINT; 239 | ch, terminator : CHAR; 240 | inFormat : BOOLEAN; 241 | outBuffer : Text.Buffer; 242 | keyBuffer : Text.Buffer; key, value : String; 243 | BEGIN 244 | i := 0; 245 | inFormat := FALSE; 246 | outBuffer.Init(32); 247 | keyBuffer.Init(32); 248 | LOOP 249 | IF i >= LEN(string) THEN EXIT END; 250 | ch := string[i]; INC(i); 251 | IF ch=0X THEN EXIT END; 252 | IF inFormat THEN 253 | IF ch = terminator THEN 254 | inFormat := FALSE; 255 | key := keyBuffer.GetString(); 256 | value := SA.Get(environment, key^); 257 | IF value # NIL THEN 258 | IF terminator = ']' THEN 259 | value := ExpandEnvironmentVariables(value^); 260 | END; 261 | (* Out.String("Expand "); Out.String(key^); 262 | Out.String("-->"); Out.String(value^); 263 | Out.Ln; *) 264 | outBuffer.String(value^); 265 | ELSE 266 | Out.String("Undefined key "); Out.String(key^); Out.Ln; 267 | END; 268 | ELSE 269 | keyBuffer.Char(ch); 270 | END 271 | ELSE 272 | CASE ch OF 273 | | '{': 274 | inFormat := TRUE; terminator := '}'; 275 | keyBuffer.Clear; 276 | | '[': 277 | inFormat := TRUE; terminator := ']'; 278 | keyBuffer.Clear; 279 | | '\': 280 | (* escape any character, including '\' and '{' *) 281 | IF i < LEN(string) THEN 282 | ch := string[i]; INC(i); 283 | outBuffer.Char(ch); 284 | END; 285 | ELSE 286 | outBuffer.Char(ch); 287 | END; 288 | END 289 | END; 290 | RETURN outBuffer.GetString(); 291 | END Substitute; 292 | 293 | END arPattern. 294 | -------------------------------------------------------------------------------- /src/aria/arSize.ob2: -------------------------------------------------------------------------------- 1 | (* Min/Max for basic types *) 2 | 3 | MODULE arSize; 4 | 5 | PROCEDURE Min*(a, b : LONGINT) : LONGINT; 6 | BEGIN 7 | IF a < b THEN RETURN a ELSE RETURN b END; 8 | END Min; 9 | 10 | PROCEDURE Max*(a, b : LONGINT) : LONGINT; 11 | BEGIN 12 | IF a > b THEN RETURN a ELSE RETURN b END; 13 | END Max; 14 | 15 | PROCEDURE MinReal*(a, b : REAL) : REAL; 16 | BEGIN 17 | IF a < b THEN RETURN a ELSE RETURN b END; 18 | END MinReal; 19 | 20 | PROCEDURE MaxReal*(a, b : REAL) : REAL; 21 | BEGIN 22 | IF a > b THEN RETURN a ELSE RETURN b END; 23 | END MaxReal; 24 | 25 | PROCEDURE MinLReal*(a, b : LONGREAL) : LONGREAL; 26 | BEGIN 27 | IF a < b THEN RETURN a ELSE RETURN b END; 28 | END MinLReal; 29 | 30 | PROCEDURE MaxLReal*(a, b : LONGREAL) : LONGREAL; 31 | BEGIN 32 | IF a > b THEN RETURN a ELSE RETURN b END; 33 | END MaxLReal; 34 | 35 | END arSize. 36 | 37 | -------------------------------------------------------------------------------- /src/aria/arStream.ob2: -------------------------------------------------------------------------------- 1 | MODULE arStream; 2 | 3 | IMPORT 4 | SYSTEM, 5 | Text := arText; 6 | 7 | TYPE 8 | FILE* = POINTER [untagged] TO RECORD [untagged] END; 9 | 10 | (* A Text.Stream that writes to a stdio FILE *) 11 | 12 | StreamPtr = POINTER TO Stream; 13 | Stream* = RECORD (Text.Stream) 14 | file : FILE; 15 | END; 16 | 17 | File* = RECORD (Text.StreamWriter) 18 | END; 19 | 20 | VAR 21 | out* : Text.StreamWriter; 22 | err* : Text.StreamWriter; 23 | 24 | PROCEDURE -AAincludeStdio* "#include "; 25 | PROCEDURE -getStdOut():FILE "(arStream_FILE) stdout"; 26 | PROCEDURE -getStdErr():FILE "(arStream_FILE) stderr"; 27 | PROCEDURE -fputc(file : FILE; ch : CHAR) "fputc(ch,(FILE *)file)"; 28 | PROCEDURE -fputs(file : FILE; str : ARRAY OF CHAR) "fputs((const char *)str,(FILE *)file)"; 29 | PROCEDURE -fflush(file : FILE) "fflush((FILE *)file)"; 30 | PROCEDURE -fclose*(file : FILE) "fclose((FILE *)file)"; 31 | PROCEDURE -fopen*(name, mode : ARRAY OF CHAR) : FILE 32 | "(arStream_FILE) fopen((const char *)name, (const char *)mode)"; 33 | 34 | (* ------ Stream ------ *) 35 | 36 | PROCEDURE (VAR self : Stream) Char*(value : CHAR); 37 | BEGIN 38 | fputc(self.file, value); 39 | END Char; 40 | 41 | PROCEDURE (VAR self : Stream) String*(value-: ARRAY OF CHAR); 42 | BEGIN 43 | fputs(self.file, value); 44 | END String; 45 | 46 | PROCEDURE (VAR self : Stream) Flush*; 47 | BEGIN 48 | fflush(self.file); 49 | END Flush; 50 | 51 | PROCEDURE NewStream(file : FILE) : StreamPtr; 52 | VAR s : StreamPtr; 53 | BEGIN 54 | NEW(s); s.file := file; 55 | RETURN s; 56 | END NewStream; 57 | 58 | (* ------ File ------ *) 59 | 60 | PROCEDURE (VAR self : File) Close*; 61 | BEGIN 62 | fclose(self.stream(StreamPtr).file) 63 | END Close; 64 | 65 | PROCEDURE (VAR self : File) Open*(name, mode : ARRAY OF CHAR) : BOOLEAN; 66 | VAR file : FILE; 67 | BEGIN 68 | file := fopen(name, mode); 69 | IF file = NIL THEN RETURN FALSE END; 70 | self.Init(NewStream(file)); 71 | RETURN TRUE; 72 | END Open; 73 | 74 | BEGIN 75 | out.Init(NewStream(getStdOut())); 76 | err.Init(NewStream(getStdOut())); 77 | END arStream. 78 | -------------------------------------------------------------------------------- /src/aria/arStringAssoc.ob2: -------------------------------------------------------------------------------- 1 | (* Mapping from String -> String, used mainly by arConfiguration. *) 2 | 3 | MODULE arStringAssoc; 4 | 5 | IMPORT 6 | SL := arStringList, 7 | S := arStrings; 8 | 9 | TYPE 10 | String* = SL.String; 11 | 12 | Assoc* = POINTER TO RECORD 13 | key* : String; 14 | value* : String; 15 | next* : Assoc; 16 | END; 17 | 18 | PROCEDURE Find*(assoc : Assoc; key : ARRAY OF CHAR) : Assoc; 19 | BEGIN 20 | WHILE assoc # NIL DO 21 | IF S.Equal(key, assoc.key^) THEN 22 | RETURN assoc; 23 | END; 24 | assoc := assoc.next; 25 | END; 26 | RETURN NIL; 27 | END Find; 28 | 29 | PROCEDURE FindValue*(assoc : Assoc; key : ARRAY OF CHAR) : Assoc; 30 | BEGIN 31 | WHILE assoc # NIL DO 32 | IF S.Equal(key, assoc.value^) THEN 33 | RETURN assoc; 34 | END; 35 | assoc := assoc.next; 36 | END; 37 | RETURN NIL; 38 | END FindValue; 39 | 40 | (* add a possibly multi-valued association *) 41 | 42 | PROCEDURE Set0*(VAR assoc : Assoc; key, value : ARRAY OF CHAR); 43 | VAR binding : Assoc; 44 | BEGIN 45 | NEW(binding); 46 | binding.key := SL.Copy(key); 47 | binding.value := SL.Copy(value); 48 | binding.next := assoc; 49 | assoc := binding; 50 | END Set0; 51 | 52 | (* add a single association *) 53 | 54 | PROCEDURE Set*(VAR assoc : Assoc; key, value : ARRAY OF CHAR); 55 | VAR binding : Assoc; 56 | BEGIN 57 | binding := Find(assoc, key); 58 | IF binding # NIL THEN 59 | binding.value := SL.Copy(value); 60 | ELSE 61 | Set0(assoc, key, value); 62 | END; 63 | END Set; 64 | 65 | (* return the first value for key *) 66 | 67 | PROCEDURE Get*(assoc : Assoc; key : ARRAY OF CHAR) : String; 68 | VAR binding : Assoc; 69 | BEGIN 70 | binding := Find(assoc, key); 71 | IF binding # NIL THEN 72 | RETURN binding.value; 73 | END; 74 | RETURN NIL; 75 | END Get; 76 | 77 | (* return key for value, or NIL if there is no association *) 78 | 79 | PROCEDURE GetKey*(assoc : Assoc; value : ARRAY OF CHAR) : String; 80 | VAR binding : Assoc; 81 | BEGIN 82 | binding := FindValue(assoc, value); 83 | IF binding # NIL THEN 84 | RETURN binding.key; 85 | END; 86 | RETURN NIL; 87 | END GetKey; 88 | 89 | (* return list of all values for key: may be zero, one, or more elements *) 90 | 91 | PROCEDURE GetAll*(assoc : Assoc; key : ARRAY OF CHAR) : SL.List; 92 | VAR result : SL.List; 93 | BEGIN 94 | result := NIL; 95 | WHILE assoc # NIL DO 96 | IF S.Equal(key, assoc.key^) THEN 97 | SL.Add(result, assoc.value) 98 | END; 99 | assoc := assoc.next; 100 | END; 101 | RETURN result; 102 | END GetAll; 103 | 104 | END arStringAssoc. 105 | -------------------------------------------------------------------------------- /src/aria/arStringList.ob2: -------------------------------------------------------------------------------- 1 | (* List of String, used mainly for arConfiguration and arPattern *) 2 | 3 | MODULE arStringList; 4 | 5 | (* enhanced ooc2Strings *) 6 | 7 | IMPORT 8 | S := arStrings; 9 | 10 | TYPE 11 | String* = S.StringPtr; 12 | Array* = POINTER TO ARRAY OF String; 13 | 14 | List* = POINTER TO RECORD 15 | name* : String; 16 | next* : List; 17 | END; 18 | 19 | (* Make dynamic copy of String on the heap *) 20 | 21 | PROCEDURE Copy*(name : ARRAY OF CHAR) : String; 22 | VAR result : String; 23 | BEGIN 24 | NEW(result, S.Length(name)+1); 25 | COPY(name, result^); 26 | RETURN result; 27 | END Copy; 28 | 29 | PROCEDURE Contains*(list : List; string : String) : BOOLEAN; 30 | BEGIN 31 | WHILE list # NIL DO 32 | IF S.Equal(list.name^, string^) THEN RETURN TRUE END; 33 | list := list.next; 34 | END; 35 | RETURN FALSE; 36 | END Contains; 37 | 38 | PROCEDURE Add*(VAR list : List; string : String); 39 | VAR element : List; 40 | BEGIN 41 | NEW(element); 42 | element.name := string; 43 | element.next := list; 44 | list := element; 45 | END Add; 46 | 47 | PROCEDURE Reverse*(VAR list : List); 48 | VAR l, this : List; 49 | BEGIN 50 | l := list; 51 | list := NIL; 52 | WHILE l # NIL DO 53 | this := l; 54 | l := l.next; 55 | this.next := list; 56 | list := this; 57 | END; 58 | END Reverse; 59 | 60 | PROCEDURE ToArray*(list : List) : Array; 61 | VAR 62 | l : List; 63 | a : Array; 64 | length : LONGINT; 65 | BEGIN 66 | l := list; 67 | length := 0; 68 | WHILE l # NIL DO 69 | INC(length); 70 | l := l.next; 71 | END; 72 | NEW(a, length); 73 | l := list; 74 | length := 0; 75 | WHILE l # NIL DO 76 | a[length] := l.name; 77 | INC(length); 78 | l := l.next; 79 | END; 80 | RETURN a; 81 | END ToArray; 82 | 83 | PROCEDURE Include*(VAR list : List; string : String); 84 | BEGIN 85 | IF ~Contains(list, string) THEN 86 | Add(list, string); 87 | END; 88 | END Include; 89 | 90 | PROCEDURE Merge*(src : List; VAR dest : List); 91 | BEGIN 92 | WHILE src # NIL DO 93 | Include(dest, src.name); 94 | src := src.next; 95 | END; 96 | END Merge; 97 | 98 | PROCEDURE ArrayContains*(array : Array; string : String) : BOOLEAN; 99 | VAR i : LONGINT; 100 | BEGIN 101 | FOR i := 0 TO LEN(array^)-1 DO 102 | IF S.Equal(array[i]^, string^) THEN RETURN TRUE END; 103 | END; 104 | RETURN FALSE; 105 | END ArrayContains; 106 | 107 | END arStringList. 108 | -------------------------------------------------------------------------------- /src/aria/arStrings.ob2: -------------------------------------------------------------------------------- 1 | (* Assorted functions for strings represented in CHAR ARRAYs. This includes 2 | some functions from ooc2Strings. *) 3 | 4 | MODULE arStrings; 5 | 6 | TYPE 7 | String* = ARRAY OF CHAR; 8 | StringPtr* = POINTER TO String; 9 | LengthType* = LONGINT; 10 | 11 | PROCEDURE Length* (stringVal-: String): LengthType; 12 | (* Returns the length of `stringVal'. This is equal to the number of 13 | characters in `stringVal' up to and excluding the first 0X. *) 14 | VAR 15 | i: LengthType; 16 | BEGIN 17 | i := 0; 18 | WHILE (stringVal[i] # 0X) DO 19 | INC (i) 20 | END; 21 | RETURN i 22 | END Length; 23 | 24 | PROCEDURE Equal* (stringVal1-, stringVal2-: String): BOOLEAN; 25 | (* Returns `stringVal1 = stringVal2'. Unlike the predefined operator `=', this 26 | procedure can be assigned to a procedure variable. *) 27 | VAR 28 | i: LengthType; 29 | BEGIN 30 | i := 0; 31 | WHILE (stringVal1[i] # 0X) & (stringVal1[i] = stringVal2[i]) DO 32 | INC (i) 33 | END; 34 | RETURN (stringVal1[i] = 0X) & (stringVal2[i] = 0X) 35 | END Equal; 36 | 37 | PROCEDURE Assign* (source-: String; VAR destination: String); 38 | (* Copies `source' to `destination'. Equivalent to the predefined procedure 39 | COPY. Unlike COPY, this procedure can be assigned to a procedure 40 | variable. *) 41 | VAR 42 | i: LengthType; 43 | BEGIN 44 | i := -1; 45 | REPEAT 46 | INC (i); 47 | destination[i] := source[i] 48 | UNTIL (destination[i] = 0X) OR (i = LEN (destination)-1); 49 | destination[i] := 0X 50 | END Assign; 51 | 52 | PROCEDURE Extract* (source-: String; startPos, numberToExtract: LengthType; 53 | VAR destination: String); 54 | (* Copies at most `numberToExtract' characters from `source' to `destination', 55 | starting at position `startPos' in `source'. An empty string value will be 56 | extracted if `startPos' is greater than or equal to `Length(source)'. 57 | pre: `startPos' and `numberToExtract' are not negative. *) 58 | VAR 59 | sourceLength, i: LengthType; 60 | BEGIN 61 | (* make sure that we get an empty string if `startPos' refers to an array 62 | index beyond `Length (source)' *) 63 | sourceLength := Length (source); 64 | IF (startPos > sourceLength) THEN 65 | startPos := sourceLength 66 | END; 67 | 68 | (* make sure that `numberToExtract' doesn't exceed the capacity 69 | of `destination' *) 70 | IF (numberToExtract >= LEN (destination)) THEN 71 | numberToExtract := LEN (destination)-1 72 | END; 73 | 74 | (* copy up to `numberToExtract' characters to `destination' *) 75 | i := 0; 76 | WHILE (i < numberToExtract) & (source[startPos+i] # 0X) DO 77 | destination[i] := source[startPos+i]; 78 | INC (i) 79 | END; 80 | destination[i] := 0X 81 | END Extract; 82 | 83 | PROCEDURE Append* (source-: String; VAR destination: String); 84 | (* Appends source to destination. *) 85 | VAR 86 | destLength, i: LengthType; 87 | BEGIN 88 | destLength := Length (destination); 89 | i := 0; 90 | WHILE (destLength < LEN (destination)-1) & (source[i] # 0X) DO 91 | destination[destLength] := source[i]; 92 | INC (destLength); 93 | INC (i) 94 | END; 95 | destination[destLength] := 0X 96 | END Append; 97 | 98 | PROCEDURE Compare* (stringVal1-, stringVal2-: String): SHORTINT; 99 | (* Returns `less', `equal', or `greater', according as `stringVal1' is 100 | lexically less than, equal to, or greater than `stringVal2'. 101 | Note that Oberon-2 already contains predefined comparison operators on 102 | strings. *) 103 | VAR 104 | i: LengthType; 105 | BEGIN 106 | i := 0; 107 | WHILE (stringVal1[i] # 0X) & (stringVal1[i] = stringVal2[i]) DO 108 | INC (i) 109 | END; 110 | IF (stringVal1[i] < stringVal2[i]) THEN 111 | RETURN -1 112 | ELSIF (stringVal1[i] > stringVal2[i]) THEN 113 | RETURN 1 114 | ELSE 115 | RETURN 0 116 | END 117 | END Compare; 118 | 119 | PROCEDURE StartsWith*(str-, prefix- : String) : BOOLEAN; 120 | VAR lenStr, lenPrefix, i : LengthType; 121 | BEGIN 122 | lenStr := Length(str); 123 | lenPrefix := Length(prefix); 124 | IF lenPrefix > lenStr THEN RETURN FALSE END; 125 | FOR i := 0 TO lenPrefix-1 DO 126 | IF prefix[i] # str[i] THEN RETURN FALSE END; 127 | END; 128 | RETURN TRUE; 129 | END StartsWith; 130 | 131 | PROCEDURE EndsWith*(str-, suffix- : String) : BOOLEAN; 132 | VAR lenStr, lenSuffix, i : LengthType; 133 | BEGIN 134 | lenStr := Length(str); 135 | lenSuffix := Length(suffix); 136 | IF lenSuffix > lenStr THEN RETURN FALSE END; 137 | FOR i := 0 TO lenSuffix-1 DO 138 | IF suffix[i] # str[lenStr-lenSuffix+i] THEN RETURN FALSE END; 139 | END; 140 | RETURN TRUE; 141 | END EndsWith; 142 | 143 | PROCEDURE IndexOf*(str- : String; ch : CHAR; pos : LengthType) : LengthType; 144 | VAR length : LengthType; 145 | BEGIN 146 | length := Length(str); 147 | IF length = 0 THEN RETURN -1 END; 148 | IF pos < 0 THEN pos := length + pos END; 149 | IF (pos < 0) OR (pos>=length) THEN RETURN -1 END; 150 | WHILE pos < length DO 151 | IF str[pos] = ch THEN RETURN pos END; 152 | INC(pos); 153 | END; 154 | RETURN -1; 155 | END IndexOf; 156 | 157 | PROCEDURE LastIndexOf*(str- : String; ch : CHAR; pos : LengthType) : LengthType; 158 | VAR length : LengthType; 159 | BEGIN 160 | length := Length(str); 161 | IF length = 0 THEN RETURN -1 END; 162 | IF pos < 0 THEN pos := length + pos END; 163 | IF (pos < 0) OR (pos>=length) THEN RETURN -1 END; 164 | WHILE pos >= 0 DO 165 | IF str[pos] = ch THEN RETURN pos END; 166 | DEC(pos); 167 | END; 168 | RETURN -1; 169 | END LastIndexOf; 170 | 171 | PROCEDURE Copy*(value- : String) : StringPtr; 172 | VAR length : LengthType; result : StringPtr; 173 | BEGIN 174 | length := Length(value); 175 | NEW(result, length+1); 176 | COPY(value, result^); 177 | RETURN result; 178 | END Copy; 179 | 180 | END arStrings. 181 | -------------------------------------------------------------------------------- /src/aria/arText.ob2: -------------------------------------------------------------------------------- 1 | (* 2 | Text.Writer knows how to convert various primitive values to text. 3 | Text.Stream is a simpler interface that just converts characters and strings 4 | (but see below). 5 | 6 | Basic Writer operations are: 7 | Char, String, Integer, Real, Boolean, Set, Ln 8 | StringLiteral is for strings that are part of data structures (eg. JSON) 9 | 10 | Some options are: 11 | intFormat: format to use for integers (default is "%d") 12 | realFormat: format to use for reals (default is "%g") 13 | quoteLiterals: TRUE to quote string literals 14 | setAsList : output sets with [] delimiters (for JSON) rather than {} 15 | 16 | Text.Buffer is a mutable text string that can be built incrementally 17 | 18 | Text.Buffers are often instantiated statically as local variables, and are 19 | used for constructing strings. Logically: A Buffer IS a Stream, and a Writer 20 | USES a Stream, but this would mean instantiating a separate object on the 21 | heap (ie. Text.Buffer) whenever a string needs to be constructed. Hence this 22 | slightly unsatisfactory construction in which: a Writer IS a Stream and a 23 | Buffer IS a Writer. As a consolation, we offer StreamWriter, an alternative 24 | Writer that USES a separate Stream. 25 | 26 | *) 27 | 28 | MODULE arText; 29 | 30 | IMPORT 31 | SYSTEM, (* MOVE, ADR *) 32 | Platform, 33 | CFormat := arCFormat; 34 | 35 | TYPE 36 | String* = POINTER TO ARRAY OF CHAR; 37 | 38 | StreamPtr* = POINTER TO Stream; 39 | Stream* = RECORD 40 | END; 41 | 42 | Writer* = RECORD (Stream) 43 | intFormat* : ARRAY 8 OF CHAR; 44 | hexFormat* : ARRAY 8 OF CHAR; 45 | realFormat* : ARRAY 8 OF CHAR; 46 | quoteLiterals* : BOOLEAN; 47 | setAsList* : BOOLEAN; 48 | END; 49 | 50 | StreamWriter* = RECORD (Writer) 51 | stream- : StreamPtr; 52 | END; 53 | 54 | Buffer* = RECORD (Writer) 55 | length- : LONGINT; 56 | capacity- : LONGINT; 57 | value- : String; 58 | END; 59 | 60 | (* ------ Stream ------ *) 61 | 62 | PROCEDURE (VAR self : Stream) Char*(value : CHAR); 63 | BEGIN 64 | (* abstract *) 65 | END Char; 66 | 67 | PROCEDURE (VAR self : Stream) String*(value-: ARRAY OF CHAR); 68 | BEGIN 69 | (* abstract *) 70 | END String; 71 | 72 | PROCEDURE (VAR self : Stream) Flush*; 73 | BEGIN 74 | (* abstract *) 75 | END Flush; 76 | 77 | (* ------ Writer ------ *) 78 | 79 | PROCEDURE (VAR self : Writer) InitWriter*; 80 | BEGIN 81 | self.intFormat := "%d"; 82 | self.hexFormat := "%x"; 83 | self.realFormat := "%g"; 84 | self.quoteLiterals := FALSE; 85 | self.setAsList := FALSE; 86 | END InitWriter; 87 | 88 | PROCEDURE (VAR self : Writer) StringLiteral*(value : ARRAY OF CHAR); 89 | BEGIN 90 | IF self.quoteLiterals THEN 91 | self.Char('"'); 92 | self.String(value); 93 | self.Char('"'); 94 | ELSE 95 | self.String(value); 96 | END; 97 | END StringLiteral; 98 | 99 | PROCEDURE (VAR self : Writer) Integer*(value : LONGINT); 100 | VAR buffer : ARRAY 32 OF CHAR; 101 | BEGIN 102 | CFormat.IntToString(buffer, self.intFormat, value); 103 | self.String(buffer); 104 | END Integer; 105 | 106 | PROCEDURE (VAR self : Writer) Hex*(value : LONGINT); 107 | VAR buffer : ARRAY 32 OF CHAR; 108 | BEGIN 109 | CFormat.IntToString(buffer, self.hexFormat, value); 110 | self.String(buffer); 111 | END Hex; 112 | 113 | PROCEDURE (VAR self : Writer) Real*(value : LONGREAL); 114 | VAR buffer : ARRAY 32 OF CHAR; 115 | BEGIN 116 | CFormat.RealToString(buffer, self.realFormat, value); 117 | self.String(buffer); 118 | END Real; 119 | 120 | PROCEDURE (VAR self : Writer) Boolean*(value : BOOLEAN); 121 | BEGIN 122 | IF value THEN self.String("true") ELSE self.String("false") END; 123 | END Boolean; 124 | 125 | PROCEDURE (VAR self : Writer) Set*(value : SET); 126 | VAR i, count : INTEGER; 127 | BEGIN 128 | count := 0; 129 | IF self.setAsList THEN self.Char("[") ELSE self.Char("{") END; 130 | FOR i := 0 TO MAX(SET) DO 131 | IF i IN value THEN 132 | IF count > 0 THEN self.Char(",") END; 133 | self.Integer(i); 134 | INC(count); 135 | END; 136 | END; 137 | IF self.setAsList THEN self.Char("]") ELSE self.Char("}") END; 138 | END Set; 139 | 140 | PROCEDURE (VAR self : Writer) Ln*; 141 | BEGIN 142 | self.String(Platform.NewLine); 143 | END Ln; 144 | 145 | (* ----- Buffer ----- *) 146 | 147 | PROCEDURE (VAR self : Buffer) Init* (capacity : LONGINT); 148 | BEGIN 149 | self.InitWriter(); 150 | self.length := 0; 151 | IF capacity < 8 THEN capacity := 8; END; 152 | self.capacity := capacity; 153 | NEW(self.value, capacity); 154 | END Init; 155 | 156 | PROCEDURE (VAR self : Buffer) EnsureCapacity(capacity : LONGINT); 157 | VAR 158 | newCapacity : LONGINT; 159 | newValue : String; 160 | BEGIN 161 | IF self.length < capacity THEN 162 | newCapacity := self.capacity; 163 | WHILE newCapacity < capacity DO 164 | newCapacity := newCapacity * 2; 165 | END; 166 | self.capacity := newCapacity; 167 | NEW(newValue, newCapacity); 168 | SYSTEM.MOVE(SYSTEM.ADR(self.value[0]), SYSTEM.ADR(newValue[0]), self.length); 169 | (* COPY(self.value^, newValue^); *) 170 | self.value := newValue; 171 | END; 172 | END EnsureCapacity; 173 | 174 | PROCEDURE (VAR self : Buffer) Char*(value : CHAR); 175 | BEGIN 176 | self.EnsureCapacity(self.length+1); 177 | self.value[self.length] := value; 178 | INC(self.length); 179 | END Char; 180 | 181 | PROCEDURE (VAR self : Buffer) String*(value-: ARRAY OF CHAR); 182 | VAR 183 | i, length : LONGINT; 184 | BEGIN 185 | length := 0; 186 | WHILE (length String 39 | String.Split -> List 40 | List.Join -> String 41 | 42 | 2) Where these types are used they tend to be used together, and its 43 | inconvenient to have to import all the modules separately. 44 | 45 | *) 46 | 47 | MODULE arValue; 48 | 49 | IMPORT 50 | Text := arText, 51 | CFormat := arCFormat, 52 | S := arStrings; 53 | 54 | TYPE 55 | BaseSet* = SET; 56 | BaseReal* = LONGREAL; 57 | BaseInteger* = LONGINT; 58 | BaseString* = Text.String; 59 | 60 | Object* = POINTER TO ObjectDesc; 61 | ObjectDesc* = RECORD 62 | END; 63 | 64 | IntArray* = POINTER TO ARRAY OF LONGINT; 65 | StringArray* = POINTER TO ARRAY OF BaseString; 66 | ObjectArray* = POINTER TO ARRAY OF Object; 67 | 68 | String* = POINTER TO RECORD (ObjectDesc) 69 | value- : BaseString; 70 | length- : LONGINT; 71 | END; 72 | 73 | Boolean* = POINTER TO RECORD (ObjectDesc) 74 | value- : BOOLEAN; 75 | END; 76 | 77 | Integer* = POINTER TO RECORD (ObjectDesc) 78 | value- : BaseInteger; 79 | END; 80 | 81 | Real* = POINTER TO RECORD (ObjectDesc) 82 | value- : BaseReal; 83 | END; 84 | 85 | Set* = POINTER TO RECORD (ObjectDesc) 86 | value- : BaseSet; 87 | END; 88 | 89 | ListElement* = POINTER TO RECORD 90 | value- : Object; 91 | next- : ListElement; 92 | END; 93 | 94 | List* = POINTER TO RECORD (ObjectDesc) 95 | first-, last- : ListElement; 96 | length- : LONGINT; 97 | END; 98 | 99 | Array* = POINTER TO RECORD (ObjectDesc) 100 | value-: ObjectArray; 101 | length-: LONGINT; 102 | END; 103 | 104 | RecordElement* = POINTER TO RECORD 105 | key- : String; 106 | value* : Object; 107 | next- : RecordElement; 108 | END; 109 | 110 | Record* = POINTER TO RECORD (ObjectDesc) 111 | scope- : RecordElement; 112 | length- : LONGINT; (* number of keys for faster equality check *) 113 | last : RecordElement; 114 | END; 115 | 116 | TYPE 117 | MapFunction* = PROCEDURE (o : Object) : Object; 118 | 119 | PROCEDURE Min*(a, b : LONGINT) : LONGINT; 120 | BEGIN 121 | IF a < b THEN RETURN a ELSE RETURN b END; 122 | END Min; 123 | 124 | PROCEDURE Max*(a, b : LONGINT) : LONGINT; 125 | BEGIN 126 | IF a > b THEN RETURN a ELSE RETURN b END; 127 | END Max; 128 | 129 | PROCEDURE ^StringFromCharArray*(value-: ARRAY OF CHAR) : String; 130 | PROCEDURE ^StringFromBuffer*(VAR buffer : Text.Buffer) : String; 131 | 132 | (* ----- Object ----- *) 133 | 134 | (* Format this object as text. For debugging, or conversion to a format like JSON *) 135 | 136 | PROCEDURE (self : Object) Format*(VAR w : Text.Writer); 137 | BEGIN 138 | (* abstract *) 139 | END Format; 140 | 141 | PROCEDURE (self : Object) Copy*() : Object; 142 | BEGIN 143 | END Copy; 144 | 145 | PROCEDURE (self : Object) DeepCopy*() : Object; 146 | BEGIN 147 | RETURN self.Copy(); 148 | END DeepCopy; 149 | 150 | PROCEDURE (self : Object) ToString*() : String; 151 | VAR buffer : Text.Buffer; 152 | BEGIN 153 | buffer.Init(16); 154 | self.Format(buffer); 155 | RETURN StringFromBuffer(buffer); 156 | END ToString; 157 | 158 | PROCEDURE (self : Object) ToJSON*() : String; 159 | VAR buffer : Text.Buffer; 160 | BEGIN 161 | buffer.Init(16); 162 | buffer.quoteLiterals := TRUE; 163 | buffer.setAsList := TRUE; 164 | self.Format(buffer); 165 | RETURN StringFromBuffer(buffer); 166 | END ToJSON; 167 | 168 | PROCEDURE (self : Object) Equals*(other : Object) : BOOLEAN; 169 | BEGIN 170 | RETURN FALSE; 171 | END Equals; 172 | 173 | PROCEDURE ToString*(self : Object) : String; 174 | BEGIN 175 | IF self = NIL THEN RETURN StringFromCharArray("null") END; 176 | RETURN self.ToString(); 177 | END ToString; 178 | 179 | PROCEDURE ToJSON*(self : Object) : String; 180 | BEGIN 181 | IF self = NIL THEN RETURN StringFromCharArray("null") END; 182 | RETURN self.ToJSON(); 183 | END ToJSON; 184 | 185 | PROCEDURE Format*(VAR w : Text.Writer; o : Object); 186 | BEGIN 187 | IF o = NIL THEN 188 | w.String("null"); 189 | ELSE 190 | o.Format(w) 191 | END; 192 | END Format; 193 | 194 | PROCEDURE Copy*(o : Object) : Object; 195 | BEGIN 196 | IF o = NIL THEN 197 | RETURN NIL; 198 | ELSE 199 | RETURN o.Copy(); 200 | END 201 | END Copy; 202 | 203 | PROCEDURE DeepCopy*(o : Object) : Object; 204 | BEGIN 205 | IF o = NIL THEN 206 | RETURN NIL; 207 | ELSE 208 | RETURN o.DeepCopy(); 209 | END 210 | END DeepCopy; 211 | 212 | PROCEDURE Equals*(a, b : Object) : BOOLEAN; 213 | BEGIN 214 | IF (a=NIL) & (b=NIL) THEN 215 | RETURN TRUE; 216 | ELSIF (a=NIL) OR (b=NIL) THEN 217 | RETURN FALSE; 218 | ELSE 219 | RETURN a.Equals(b); 220 | END; 221 | END Equals; 222 | 223 | PROCEDURE FormatQ*(VAR w : Text.Writer; o : Object); 224 | VAR wasQuoted : BOOLEAN; 225 | BEGIN 226 | wasQuoted := w.quoteLiterals; 227 | w.quoteLiterals := TRUE; 228 | Format(w, o); 229 | w.quoteLiterals := wasQuoted; 230 | END FormatQ; 231 | 232 | (* ----- String ----- *) 233 | 234 | PROCEDURE StringFromCharArray*(value-: ARRAY OF CHAR) : String; 235 | VAR s : String; 236 | BEGIN 237 | NEW(s); 238 | s.length := S.Length(value); 239 | NEW(s.value, s.length+1); 240 | COPY(value, s.value^); 241 | RETURN s; 242 | END StringFromCharArray; 243 | 244 | PROCEDURE char*(value : CHAR) : String; 245 | VAR array : ARRAY 2 OF CHAR; 246 | BEGIN 247 | array[0] := value; array[1] := 0X; 248 | RETURN StringFromCharArray(array); 249 | END char; 250 | 251 | (* Create a String from an existing dynamic array. Uses the array directly 252 | without making a copy *) 253 | 254 | PROCEDURE StringFromCharPointer*(value : BaseString) : String; 255 | VAR s : String; 256 | BEGIN 257 | NEW(s); 258 | s.value := value; 259 | s.length := S.Length(value^); 260 | RETURN s; 261 | END StringFromCharPointer; 262 | 263 | (* Create a String from an existing String.Buffer *) 264 | 265 | PROCEDURE StringFromBuffer*(VAR buffer : Text.Buffer) : String; 266 | BEGIN 267 | RETURN StringFromCharPointer(buffer.GetString()); 268 | END StringFromBuffer; 269 | 270 | PROCEDURE (self : String) Equals*(other : Object) : BOOLEAN; 271 | BEGIN 272 | WITH other : String DO 273 | RETURN S.Equal(self.value^, other.value^) 274 | ELSE 275 | RETURN FALSE 276 | END 277 | END Equals; 278 | 279 | PROCEDURE (self : String) CopyT*() : String; 280 | BEGIN 281 | RETURN StringFromCharPointer(self.value); 282 | END CopyT; 283 | 284 | PROCEDURE (self : String) Copy*() : Object; 285 | BEGIN 286 | RETURN self.CopyT(); 287 | END Copy; 288 | 289 | PROCEDURE (self : String) Format*(VAR w : Text.Writer); 290 | BEGIN 291 | w.StringLiteral(self.value^) 292 | END Format; 293 | 294 | PROCEDURE (self : String) Concat*(arg : String) : String; 295 | VAR result : String; 296 | BEGIN 297 | NEW(result); 298 | result.length := self.length + arg.length; 299 | NEW(result.value, result.length+1); 300 | COPY(self.value^, result.value^); 301 | S.Append(arg.value^, result.value^); 302 | RETURN result; 303 | END Concat; 304 | 305 | PROCEDURE (self : String) ToInteger*() : LONGINT; 306 | VAR 307 | i, res : LONGINT; 308 | BEGIN 309 | i := 0; 310 | res := CFormat.StringToInt(self.value^, i); 311 | RETURN i; 312 | END ToInteger; 313 | 314 | PROCEDURE (self : String) ToReal*() : LONGREAL; 315 | VAR 316 | res : LONGINT; value : LONGREAL; 317 | BEGIN 318 | value := 0; 319 | res := CFormat.StringToReal(self.value^, value); 320 | RETURN value; 321 | END ToReal; 322 | 323 | PROCEDURE (self : String) Extract*(start, count : LONGINT) : String; 324 | VAR 325 | result : BaseString; 326 | i : LONGINT; 327 | BEGIN 328 | IF start < 0 THEN 329 | start := self.length + start; 330 | END; 331 | start := Min(self.length, Max(start, 0)); 332 | count := Min(Max(count, 0), self.length-start); 333 | NEW(result, count+1); 334 | FOR i := 0 TO count-1 DO 335 | result[i] := self.value[i+start] 336 | END; 337 | result[count] := 0X; 338 | RETURN StringFromCharPointer(result); 339 | END Extract; 340 | 341 | PROCEDURE (self : String) Compare*(value-: ARRAY OF CHAR) : SHORTINT; 342 | BEGIN 343 | RETURN S.Compare(self.value^, value); 344 | END Compare; 345 | 346 | PROCEDURE (self : String) EndsWith*(value-: ARRAY OF CHAR) : BOOLEAN; 347 | VAR i, length : LONGINT; 348 | BEGIN 349 | length := S.Length(value); 350 | IF self.length < length THEN RETURN FALSE END; 351 | FOR i := 0 TO length-1 DO 352 | IF value[i] # self.value[self.length-length+i] THEN RETURN FALSE END; 353 | END; 354 | RETURN TRUE; 355 | END EndsWith; 356 | 357 | PROCEDURE (self : String) StartsWith*(value-: ARRAY OF CHAR) : BOOLEAN; 358 | VAR i, length : LONGINT; 359 | BEGIN 360 | length := S.Length(value); 361 | IF self.length < length THEN RETURN FALSE END; 362 | FOR i := 0 TO length-1 DO 363 | IF value[i] # self.value[i] THEN RETURN FALSE END; 364 | END; 365 | RETURN TRUE; 366 | END StartsWith; 367 | 368 | (* ----- Boolean ----- *) 369 | 370 | PROCEDURE NewBoolean*(value : BOOLEAN) : Boolean; 371 | VAR b : Boolean; 372 | BEGIN 373 | NEW(b); b.value := value; RETURN b; 374 | END NewBoolean; 375 | 376 | PROCEDURE ParseBool*(value-: ARRAY OF CHAR) : Boolean; 377 | BEGIN 378 | IF value = "true" THEN 379 | RETURN NewBoolean(TRUE); 380 | ELSIF value = "false" THEN 381 | RETURN NewBoolean(FALSE); 382 | END; 383 | RETURN NIL; 384 | END ParseBool; 385 | 386 | PROCEDURE (self : Boolean) CopyT*() : Boolean; 387 | BEGIN 388 | RETURN NewBoolean(self.value); 389 | END CopyT; 390 | 391 | PROCEDURE (self : Boolean) Copy*() : Object; 392 | BEGIN 393 | RETURN self.CopyT(); 394 | END Copy; 395 | 396 | PROCEDURE (self : Boolean) Equals*(other : Object) : BOOLEAN; 397 | BEGIN 398 | WITH other : Boolean DO 399 | RETURN self.value = other.value 400 | ELSE 401 | RETURN FALSE 402 | END 403 | END Equals; 404 | 405 | PROCEDURE (self : Boolean) Format*(VAR w : Text.Writer); 406 | BEGIN 407 | w.Boolean(self.value); 408 | END Format; 409 | 410 | (* ----- Set ----- *) 411 | 412 | PROCEDURE NewSet*(value : BaseSet) : Set; 413 | VAR s : Set; 414 | BEGIN 415 | NEW(s); s.value := value; RETURN s; 416 | END NewSet; 417 | 418 | PROCEDURE (self : Set) Equals*(other : Object) : BOOLEAN; 419 | BEGIN 420 | WITH other : Set DO 421 | RETURN self.value = other.value 422 | ELSE 423 | RETURN FALSE 424 | END 425 | END Equals; 426 | 427 | PROCEDURE (self : Set) CopyT*() : Set; 428 | BEGIN 429 | RETURN NewSet(self.value); 430 | END CopyT; 431 | 432 | PROCEDURE (self : Set) Copy*() : Object; 433 | BEGIN 434 | RETURN self.CopyT(); 435 | END Copy; 436 | 437 | PROCEDURE (self : Set) Format*(VAR w : Text.Writer); 438 | BEGIN 439 | w.Set(self.value) 440 | END Format; 441 | 442 | (* ----- Integer ----- *) 443 | 444 | PROCEDURE NewInteger*(value : BaseInteger) : Integer; 445 | VAR i : Integer; 446 | BEGIN 447 | NEW(i); i.value := value; RETURN i; 448 | END NewInteger; 449 | 450 | PROCEDURE ParseInt*(value-: ARRAY OF CHAR) : Integer; 451 | VAR 452 | i : BaseInteger; 453 | res : LONGINT; 454 | BEGIN 455 | res := CFormat.StringToInt(value, i); 456 | IF res = 1 THEN 457 | RETURN NewInteger(i) 458 | END; 459 | RETURN NIL; 460 | END ParseInt; 461 | 462 | PROCEDURE (self : Integer) Equals*(other : Object) : BOOLEAN; 463 | BEGIN 464 | WITH other : Integer DO 465 | RETURN self.value = other.value 466 | ELSE 467 | RETURN FALSE 468 | END 469 | END Equals; 470 | 471 | PROCEDURE (self : Integer) CopyT*() : Integer; 472 | BEGIN 473 | RETURN NewInteger(self.value); 474 | END CopyT; 475 | 476 | PROCEDURE (self : Integer) Copy*() : Object; 477 | BEGIN 478 | RETURN self.CopyT(); 479 | END Copy; 480 | 481 | PROCEDURE (self : Integer) Format*(VAR w : Text.Writer); 482 | BEGIN 483 | w.Integer(self.value) 484 | END Format; 485 | 486 | (* ----- Real ----- *) 487 | 488 | (* TODO: fix string representation *) 489 | 490 | PROCEDURE NewReal*(value : BaseReal) : Real; 491 | VAR r : Real; 492 | BEGIN 493 | NEW(r); r.value := value; RETURN r; 494 | END NewReal; 495 | 496 | PROCEDURE ParseReal*(value-: ARRAY OF CHAR) : Real; 497 | VAR 498 | r : BaseReal; 499 | res : LONGINT; 500 | BEGIN 501 | res := CFormat.StringToReal(value, r); 502 | IF res = 1 THEN 503 | RETURN NewReal(r) 504 | END; 505 | RETURN NIL; 506 | END ParseReal; 507 | 508 | PROCEDURE (self : Real) Equals*(other : Object) : BOOLEAN; 509 | BEGIN 510 | WITH other : Real DO 511 | RETURN self.value = other.value 512 | ELSE 513 | RETURN FALSE 514 | END 515 | END Equals; 516 | 517 | PROCEDURE (self : Real) CopyT*() : Real; 518 | BEGIN 519 | RETURN NewReal(self.value); 520 | END CopyT; 521 | 522 | PROCEDURE (self : Real) Copy*() : Object; 523 | BEGIN 524 | RETURN self.CopyT(); 525 | END Copy; 526 | 527 | PROCEDURE (self : Real) Format*(VAR w : Text.Writer); 528 | BEGIN 529 | w.Real(self.value); 530 | END Format; 531 | 532 | (* ---- List ----- *) 533 | 534 | (* List of objects, stored in a linked list. 535 | TODO: doubly linked list would be better for insertion / deletion 536 | *) 537 | 538 | PROCEDURE NewList*() : List; 539 | VAR 540 | l : List; 541 | BEGIN 542 | NEW(l); 543 | l.first := NIL; 544 | l.last := NIL; 545 | l.length := 0; 546 | RETURN l; 547 | END NewList; 548 | 549 | PROCEDURE (self : List) Equals*(other : Object) : BOOLEAN; 550 | VAR a, b : ListElement; 551 | BEGIN 552 | WITH other : List DO 553 | IF self.length # other.length THEN RETURN FALSE END; 554 | a := self.first; b := other.first; 555 | WHILE (a # NIL) & (b # NIL) DO 556 | IF ~Equals(a.value, b.value) THEN RETURN FALSE END; 557 | a := a.next; b := b.next; 558 | END; 559 | ASSERT(a = b); 560 | RETURN TRUE; 561 | ELSE 562 | RETURN FALSE 563 | END 564 | END Equals; 565 | 566 | PROCEDURE (self : List) Format*(VAR w : Text.Writer); 567 | VAR 568 | n : ListElement; 569 | BEGIN 570 | w.Char("["); 571 | n := self.first; 572 | WHILE n # NIL DO 573 | FormatQ(w, n.value); 574 | n := n.next; 575 | IF n # NIL THEN w.Char(",") END; 576 | END; 577 | w.Char("]"); 578 | END Format; 579 | 580 | PROCEDURE (l : List) IndexOf*(value : Object) : LONGINT; 581 | VAR i : LONGINT; a : ListElement; 582 | BEGIN 583 | i := 0; 584 | a := l.first; 585 | WHILE a # NIL DO 586 | IF Equals(value, a.value) THEN RETURN i END; 587 | INC(i); 588 | a := a.next; 589 | END; 590 | RETURN -1 591 | END IndexOf; 592 | 593 | PROCEDURE (self : List) Append*(o : Object); 594 | VAR node : ListElement; 595 | BEGIN 596 | NEW(node); node.value := o; node.next := NIL; 597 | IF self.length = 0 THEN 598 | self.first := node; 599 | ELSE 600 | self.last.next := node; 601 | END; 602 | self.last := node; 603 | INC(self.length); 604 | END Append; 605 | 606 | PROCEDURE (self : List) Concat*(value : List) : List; 607 | VAR 608 | result : List; 609 | e : ListElement; 610 | BEGIN 611 | result := NewList(); 612 | e := self.first; 613 | WHILE e # NIL DO 614 | result.Append(e.value); 615 | e := e.next; 616 | END; 617 | e := value.first; 618 | WHILE e # NIL DO 619 | result.Append(e.value); 620 | e := e.next; 621 | END; 622 | RETURN result; 623 | END Concat; 624 | 625 | PROCEDURE (self : List) Prepend*(o : Object); 626 | VAR node : ListElement; 627 | BEGIN 628 | NEW(node); node.value := o; node.next := self.first; 629 | IF self.length = 0 THEN 630 | self.last := node; 631 | END; 632 | self.first := node; 633 | INC(self.length); 634 | END Prepend; 635 | 636 | PROCEDURE (self : List) Extend*(value : List); 637 | VAR e : ListElement; 638 | BEGIN 639 | e := value.first; 640 | WHILE e # NIL DO 641 | self.Append(e.value); 642 | e := e.next; 643 | END; 644 | END Extend; 645 | 646 | PROCEDURE (self : List) ToIntArray*() : IntArray; 647 | VAR 648 | i, count : LONGINT; 649 | it : ListElement; 650 | result : IntArray; 651 | BEGIN 652 | count := 0; 653 | it := self.first; 654 | WHILE it # NIL DO 655 | IF it.value IS Integer THEN 656 | INC(count); 657 | END; 658 | it := it.next; 659 | END; 660 | NEW(result, count); 661 | it := self.first; 662 | i := 0; 663 | WHILE it # NIL DO 664 | IF it.value IS Integer THEN 665 | result[i] := it.value(Integer).value; 666 | INC(i); 667 | END; 668 | it := it.next; 669 | END; 670 | ASSERT(i = count); 671 | RETURN result; 672 | END ToIntArray; 673 | 674 | PROCEDURE (self : List) ToStringArray*() : StringArray; 675 | VAR 676 | i, count : LONGINT; 677 | it : ListElement; 678 | result : StringArray; 679 | BEGIN 680 | count := 0; 681 | it := self.first; 682 | WHILE it # NIL DO 683 | IF it.value IS String THEN 684 | INC(count); 685 | END; 686 | it := it.next; 687 | END; 688 | NEW(result, count); 689 | it := self.first; 690 | i := 0; 691 | WHILE it # NIL DO 692 | IF it.value IS String THEN 693 | result[i] := it.value(String).value; 694 | INC(i); 695 | END; 696 | it := it.next; 697 | END; 698 | ASSERT(i = count); 699 | RETURN result; 700 | END ToStringArray; 701 | 702 | PROCEDURE (self : List) ToObjectArray*() : ObjectArray; 703 | VAR 704 | i : LONGINT; 705 | it : ListElement; 706 | result : ObjectArray; 707 | BEGIN 708 | NEW(result, self.length); 709 | it := self.first; 710 | i := 0; 711 | WHILE it # NIL DO 712 | result[i] := it.value; 713 | INC(i); 714 | it := it.next; 715 | END; 716 | ASSERT(i = self.length); 717 | RETURN result; 718 | END ToObjectArray; 719 | 720 | PROCEDURE (self : List) ToArray() : Array; 721 | VAR a : Array; 722 | BEGIN 723 | NEW(a); 724 | a.length := self.length; 725 | a.value := self.ToObjectArray(); 726 | RETURN a; 727 | END ToArray; 728 | 729 | PROCEDURE (self : List) Get*(index : LONGINT) : Object; 730 | VAR it : ListElement; 731 | BEGIN 732 | ASSERT((index >= 0) & (index < self.length)); 733 | it := self.first; 734 | WHILE index > 0 DO 735 | it := it.next; DEC(index); 736 | END; 737 | RETURN it.value; 738 | END Get; 739 | 740 | PROCEDURE (self : List) Set*(index : LONGINT; value : Object); 741 | VAR it : ListElement; 742 | BEGIN 743 | ASSERT((index >= 0) & (index < self.length)); 744 | it := self.first; 745 | WHILE index > 0 DO 746 | it := it.next; DEC(index); 747 | END; 748 | it.value := value; 749 | END Set; 750 | 751 | PROCEDURE (self : List) Join*(separator-: ARRAY OF CHAR) : String; 752 | VAR 753 | b : Text.Buffer; 754 | it : ListElement; 755 | BEGIN 756 | b.Init(32); 757 | it := self.first; 758 | WHILE it # NIL DO 759 | Format(b, it.value); 760 | it := it.next; 761 | IF it # NIL THEN b.String(separator) END 762 | END; 763 | RETURN StringFromBuffer(b); 764 | END Join; 765 | 766 | PROCEDURE (self : List) Map*(func : MapFunction) : List; 767 | VAR 768 | funcResult : Object; 769 | result : List; 770 | it : ListElement; 771 | BEGIN 772 | result := NewList(); 773 | it := self.first; 774 | WHILE it # NIL DO 775 | funcResult := func(it.value); 776 | IF funcResult # NIL THEN 777 | result.Append(funcResult); 778 | END; 779 | it := it.next; 780 | END; 781 | END Map; 782 | 783 | PROCEDURE (self : String) Split*(separator : CHAR) : List; 784 | VAR 785 | l : List; 786 | begin, i : LONGINT; 787 | BEGIN 788 | l := NewList(); 789 | begin := 0; 790 | FOR i := 0 TO self.length-1 DO 791 | IF self.value[i] = separator THEN 792 | l.Append(self.Extract(begin, i-begin)); 793 | begin := i+1; 794 | END; 795 | END; 796 | IF begin <= self.length THEN 797 | l.Append(self.Extract(begin, self.length-begin)) 798 | END; 799 | RETURN l; 800 | END Split; 801 | 802 | PROCEDURE (self : List) CopyT*(deep : BOOLEAN) : List; 803 | VAR 804 | e : ListElement; 805 | l : List; 806 | value : Object; 807 | BEGIN 808 | l := NewList(); 809 | e := self.first; 810 | WHILE e # NIL DO 811 | value := e.value; 812 | IF deep THEN value := DeepCopy(value) END; 813 | l.Append(value); 814 | e := e.next; 815 | END; 816 | RETURN l; 817 | END CopyT; 818 | 819 | PROCEDURE (self : List) Copy*() : Object; 820 | BEGIN 821 | RETURN self.CopyT(FALSE); 822 | END Copy; 823 | 824 | PROCEDURE (self : List) DeepCopy*() : Object; 825 | BEGIN 826 | RETURN self.CopyT(TRUE); 827 | END DeepCopy; 828 | 829 | (* ----- Record ----- *) 830 | 831 | (* Mapping from String -> Object. Mappings are stored in a linked list. Not 832 | very efficient, but easy to implement. Originally used a LISP-style association 833 | list, but that doesn't well handle empty mappings. 834 | TODO: This would be better as a hash table. *) 835 | 836 | PROCEDURE NewRecord*() : Record; 837 | VAR r : Record; 838 | BEGIN 839 | NEW(r); 840 | r.scope := NIL; 841 | r.last := NIL; 842 | r.length := 0; 843 | RETURN r; 844 | END NewRecord; 845 | 846 | (* Return the value associated with *) 847 | 848 | PROCEDURE (self : Record) Get*(key-: ARRAY OF CHAR) : Object; 849 | VAR elem : RecordElement; 850 | BEGIN 851 | elem := self.scope; 852 | WHILE (elem # NIL) & (elem.key.Compare(key) # 0) DO 853 | elem := elem.next; 854 | END; 855 | IF elem # NIL THEN 856 | RETURN elem.value 857 | END; 858 | RETURN NIL 859 | END Get; 860 | 861 | (* Set the associated with . If an existing association exists, 862 | this will be replacecd *) 863 | 864 | PROCEDURE (self : Record) Bind(key-: ARRAY OF CHAR; value : Object); 865 | VAR elem : RecordElement; 866 | BEGIN 867 | (* add new key/value binding, preserving order *) 868 | NEW(elem); 869 | elem.key := StringFromCharArray(key); 870 | elem.value := value; 871 | elem.next := NIL; 872 | IF self.scope = NIL THEN 873 | self.scope := elem; 874 | ELSE 875 | self.last.next := elem; 876 | END; 877 | self.last := elem; 878 | INC(self.length); 879 | END Bind; 880 | 881 | PROCEDURE (self : Record) Equals*(value : Object) : BOOLEAN; 882 | VAR elem : RecordElement; 883 | BEGIN 884 | WITH value : Record DO 885 | IF value.length # self.length THEN RETURN FALSE END; 886 | elem := self.scope; 887 | WHILE elem # NIL DO 888 | IF ~Equals(elem.value, value.Get(elem.key.value^)) THEN RETURN FALSE END; 889 | elem := elem.next; 890 | END; 891 | RETURN TRUE; 892 | ELSE 893 | RETURN FALSE; 894 | END; 895 | END Equals; 896 | 897 | PROCEDURE (self : Record) Set*(key-: ARRAY OF CHAR; value : Object); 898 | VAR elem : RecordElement; 899 | BEGIN 900 | elem := self.scope; 901 | WHILE (elem # NIL) & (elem.key.Compare(key) # 0) DO 902 | elem := elem.next; 903 | END; 904 | IF elem = NIL THEN 905 | (* create new binding *) 906 | self.Bind(key, value); 907 | ELSE 908 | (* replace existing key binding with new value *) 909 | elem.value := value; 910 | END; 911 | END Set; 912 | 913 | PROCEDURE (self : Record) Map*(func : MapFunction) : Record; 914 | VAR 915 | r : Record; 916 | e : RecordElement; 917 | value : Object; 918 | BEGIN 919 | r := NewRecord(); 920 | e := self.scope; 921 | WHILE e # NIL DO 922 | value := func(e.value); 923 | IF value # NIL THEN 924 | r.Bind(e.key.value^, value); 925 | END; 926 | e := e.next; 927 | END; 928 | RETURN r; 929 | END Map; 930 | 931 | PROCEDURE (self : Record) CopyT*(deep : BOOLEAN) : Record; 932 | VAR 933 | r : Record; 934 | e : RecordElement; 935 | value : Object; 936 | BEGIN 937 | r := NewRecord(); 938 | e := self.scope; 939 | WHILE e # NIL DO 940 | value := e.value; 941 | IF deep THEN value := DeepCopy(value) END; 942 | r.Bind(e.key.value^, value); 943 | e := e.next; 944 | END; 945 | RETURN r; 946 | END CopyT; 947 | 948 | PROCEDURE (self : Record) Copy*() : Object; 949 | BEGIN 950 | RETURN self.CopyT(FALSE); 951 | END Copy; 952 | 953 | PROCEDURE (self : Record) DeepCopy*() : Object; 954 | BEGIN 955 | RETURN self.CopyT(TRUE); 956 | END DeepCopy; 957 | 958 | PROCEDURE (self : Record) Format*(VAR w : Text.Writer); 959 | VAR 960 | elem : RecordElement; 961 | BEGIN 962 | w.Char("{"); 963 | elem := self.scope; 964 | WHILE elem # NIL DO 965 | Format(w, elem.key); 966 | w.Char(":"); 967 | FormatQ(w, elem.value); 968 | elem := elem.next; 969 | IF elem # NIL THEN w.Char(",") END; 970 | END; 971 | w.Char("}"); 972 | END Format; 973 | 974 | (* ----- Array ------ *) 975 | 976 | (* List of objects stored as an Object array *) 977 | 978 | PROCEDURE NewArray(length : LONGINT) : Array; 979 | VAR a : Array; 980 | BEGIN 981 | NEW(a); 982 | a.length := length; 983 | NEW(a.value, length); 984 | RETURN a; 985 | END NewArray; 986 | 987 | PROCEDURE (self : Array) CopyT(deep : BOOLEAN) : Array; 988 | VAR a : Array; i : LONGINT; value : Object; 989 | BEGIN 990 | a := NewArray(self.length); 991 | FOR i := 0 TO self.length-1 DO 992 | value := self.value[i]; 993 | IF deep THEN value := DeepCopy(value) END; 994 | a.value[i] := value; 995 | END; 996 | END CopyT; 997 | 998 | PROCEDURE (self : Array) Copy*() : Object; 999 | BEGIN 1000 | RETURN self.CopyT(FALSE); 1001 | END Copy; 1002 | 1003 | PROCEDURE (self : Array) DeepCopy*() : Object; 1004 | BEGIN 1005 | RETURN self.CopyT(FALSE); 1006 | END DeepCopy; 1007 | 1008 | PROCEDURE (self : Array) Format*(VAR w : Text.Writer); 1009 | VAR 1010 | i : LONGINT; 1011 | BEGIN 1012 | w.Char("["); 1013 | FOR i := 0 TO self.length-1 DO 1014 | IF i > 0 THEN w.Char(",") END; 1015 | FormatQ(w, self.value[i]); 1016 | END; 1017 | w.Char("]"); 1018 | END Format; 1019 | 1020 | PROCEDURE (self : Array) Equals*(value : Object) : BOOLEAN; 1021 | VAR i : LONGINT; 1022 | BEGIN 1023 | WITH value : Array DO 1024 | IF self.length # value.length THEN RETURN FALSE END; 1025 | FOR i := 0 TO self.length-1 DO 1026 | IF ~Equals(self.value[i], value.value[i]) THEN RETURN FALSE END; 1027 | END; 1028 | RETURN TRUE; 1029 | ELSE 1030 | RETURN FALSE 1031 | END 1032 | END Equals; 1033 | 1034 | PROCEDURE (self : Array) Get*(index : LONGINT) : Object; 1035 | BEGIN 1036 | ASSERT((index >= 0) & (index < self.length)); 1037 | RETURN self.value[index]; 1038 | END Get; 1039 | 1040 | PROCEDURE (self : Array) Set*(index : LONGINT; value : Object) : Object; 1041 | BEGIN 1042 | ASSERT((index >= 0) & (index < self.length)); 1043 | self.value[index] := value; 1044 | END Set; 1045 | 1046 | (* ----- Miscellaneous ----- *) 1047 | 1048 | PROCEDURE Split*(value-: ARRAY OF CHAR; separator : CHAR) : List; 1049 | VAR s : String; 1050 | BEGIN 1051 | s := StringFromCharArray(value); 1052 | RETURN s.Split(separator); 1053 | END Split; 1054 | 1055 | (* ----- Convenience Constructors ----- *) 1056 | 1057 | PROCEDURE list*() : List; 1058 | BEGIN 1059 | RETURN NewList(); 1060 | END list; 1061 | 1062 | PROCEDURE record*() : Record; 1063 | BEGIN 1064 | RETURN NewRecord(); 1065 | END record; 1066 | 1067 | PROCEDURE set*(value : BaseSet) : Set; 1068 | BEGIN 1069 | RETURN NewSet(value); 1070 | END set; 1071 | 1072 | PROCEDURE bool*(value : BOOLEAN) : Boolean; 1073 | BEGIN 1074 | RETURN NewBoolean(value); 1075 | END bool; 1076 | 1077 | PROCEDURE int*(value : BaseInteger) : Integer; 1078 | BEGIN 1079 | RETURN NewInteger(value); 1080 | END int; 1081 | 1082 | PROCEDURE real*(value : BaseReal) : Real; 1083 | BEGIN 1084 | RETURN NewReal(value); 1085 | END real; 1086 | 1087 | PROCEDURE array2*(a, b : Object) : Array; 1088 | VAR result : Array; 1089 | BEGIN 1090 | result := NewArray(2); 1091 | result.value[0] := a; 1092 | result.value[1] := b; 1093 | RETURN result; 1094 | END array2; 1095 | 1096 | PROCEDURE array3*(a, b, c : Object) : Array; 1097 | VAR result : Array; 1098 | BEGIN 1099 | result := NewArray(3); 1100 | result.value[0] := a; 1101 | result.value[1] := b; 1102 | result.value[2] := c; 1103 | RETURN result; 1104 | END array3; 1105 | 1106 | PROCEDURE array4*(a, b, c, d : Object) : Array; 1107 | VAR result : Array; 1108 | BEGIN 1109 | result := NewArray(3); 1110 | result.value[0] := a; 1111 | result.value[1] := b; 1112 | result.value[2] := c; 1113 | result.value[3] := d; 1114 | RETURN result; 1115 | END array4; 1116 | 1117 | (* construct string from CHAR ARRAY *) 1118 | PROCEDURE str*(value-: ARRAY OF CHAR) : String; 1119 | BEGIN 1120 | RETURN StringFromCharArray(value); 1121 | END str; 1122 | 1123 | (* construct string from CHAR ARRAY POINTER *) 1124 | PROCEDURE strp*(value : BaseString) : String; 1125 | BEGIN 1126 | RETURN StringFromCharPointer(value); 1127 | END strp; 1128 | 1129 | (* construct string from Text.Buffer *) 1130 | PROCEDURE strb*(VAR value : Text.Buffer) : String; 1131 | BEGIN 1132 | RETURN StringFromBuffer(value); 1133 | END strb; 1134 | 1135 | END arValue. 1136 | 1137 | -------------------------------------------------------------------------------- /src/lib/libCK.ob2: -------------------------------------------------------------------------------- 1 | MODULE libCK; 2 | 3 | (* OMAKE LINK "CK" *) 4 | 5 | IMPORT SYSTEM, C := arC; 6 | 7 | TYPE 8 | Entry* = POINTER TO EntryDesc; 9 | 10 | EntryDesc* = RECORD 11 | next* : Entry; 12 | END; 13 | 14 | Stack* = RECORD 15 | head, generation : C.address; 16 | END; 17 | 18 | (* 19 | Queue* = RECORD 20 | first, last : C.address; 21 | END; 22 | *) 23 | 24 | PROCEDURE -includeLibCK* "#include "; 25 | 26 | 27 | PROCEDURE StackInit*(VAR stack : Stack); 28 | BEGIN 29 | stack.head := 0; 30 | stack.generation := 0; 31 | END StackInit; 32 | 33 | PROCEDURE -StackPush*(VAR stack : Stack; entry : Entry) 34 | "ck_stack_push_upmc((struct ck_stack *)stack, (struct ck_stack_entry *)entry)"; 35 | 36 | PROCEDURE -StackPop*(VAR stack : Stack) : Entry 37 | "(libCK_Entry)ck_stack_pop_upmc((struct ck_stack *)stack)"; 38 | 39 | PROCEDURE -StackPopAll*(VAR stack : Stack) : Entry 40 | "(libCK_Entry)ck_stack_batch_pop_upmc((struct ck_stack *)stack)"; 41 | 42 | PROCEDURE Reverse*(VAR entry : Entry); 43 | VAR in, out, this : Entry; 44 | BEGIN 45 | in := entry; 46 | out := NIL; 47 | WHILE in # NIL DO 48 | this := in; 49 | in := in.next; 50 | this.next := out; 51 | out := this; 52 | END; 53 | entry := out; 54 | END Reverse; 55 | 56 | (* 57 | PROCEDURE QueueInit*(VAR queue : Queue); 58 | BEGIN 59 | queue.first := 0; 60 | queue.last := SYSTEM.ADR(queue.first); 61 | END QueueInit; 62 | 63 | PROCEDURE -QueueRemoveHead(VAR queue : Queue) : Entry 64 | "(LibCK_Entry)CK_STAILQ_REMOVE(queue" 65 | 66 | PROCEDURE -QueueInsertTail(VAR queue : Queue; entry : Entry) 67 | CK_STAILQ_INSERT_TAIL(queue, 68 | *) 69 | 70 | END libCK. 71 | -------------------------------------------------------------------------------- /src/lib/libCairo.ob2: -------------------------------------------------------------------------------- 1 | (* 2 | An Oberon-2 binding for part of the Cairo 1.16.0 API. 3 | *) 4 | 5 | MODULE libCairo; 6 | 7 | (* OMAKE LINK "cairo" *) 8 | 9 | IMPORT SYSTEM, C := arC; 10 | 11 | CONST (* FormatT = cairo_format_t *) 12 | formatInvalid* = -1; 13 | formatARGB32* = 0; 14 | formatRGB24* = 1; 15 | formatA8* = 2; 16 | formatA1* = 3; 17 | formatRGB16565* = 4; 18 | formatRGB30* = 5; 19 | 20 | CONST (* FillRuleT = cairo_fill_rule_t *) 21 | fillRuleWinding* = 0; 22 | fillRuleEvenOdd* = 1; 23 | 24 | TYPE 25 | Surface* = POINTER [notag] TO RECORD [notag] END; 26 | 27 | ImageData* = POINTER [notag] TO ARRAY OF CHAR; 28 | 29 | Cairo* = POINTER [notag] TO RECORD [notag] END; 30 | 31 | TextExtents* = RECORD [notag] 32 | xBearing*, yBearing* : LONGREAL; 33 | width*, height* : LONGREAL; 34 | xAdvance*, yAdvance* : LONGREAL; 35 | END; 36 | 37 | FormatT* = C.int; 38 | FillRuleT* = C.int; 39 | 40 | (* object-based interface to Cairo drawing *) 41 | Painter* = POINTER TO RECORD 42 | cairo : Cairo; 43 | END; 44 | 45 | PROCEDURE -includeCairo* "#include "; 46 | 47 | (* Create surface in an array *) 48 | 49 | PROCEDURE -imageSurfaceCreateForData* ( 50 | data : ImageData; 51 | format : FormatT; width, height, stride : C.int) : Surface 52 | "(libCairo_Surface)cairo_image_surface_create_for_data((unsigned char *)data, (cairo_format_t) format, (int)width, (int)height, (int)stride)"; 53 | 54 | (* Write surface to PNG file *) 55 | 56 | PROCEDURE -surfaceWriteToPNG* (surface : Surface; file : ARRAY OF CHAR) 57 | "(cairo_status_t)cairo_surface_write_to_png((cairo_surface_t *)surface, (const char *) file)"; 58 | 59 | PROCEDURE -surfaceDestroy* (surface : Surface) 60 | "cairo_surface_destroy((cairo_surface_t *)surface)"; 61 | 62 | (* Create drawing context *) 63 | 64 | PROCEDURE -create* (surface : Surface) : Cairo 65 | "(libCairo_Cairo) cairo_create((cairo_surface_t *) surface)"; 66 | 67 | PROCEDURE -destroy* (cairo : Cairo) 68 | "cairo_destroy((cairo_t *) cairo)"; 69 | 70 | (* Drawing operations *) 71 | 72 | PROCEDURE -setSourceRGB* (cairo : Cairo; red, green, blue : LONGREAL) 73 | "cairo_set_source_rgb((cairo_t *) cairo, (double)red, (double)green, (double)blue)"; 74 | 75 | PROCEDURE (self : Painter) SetSourceRGB* (red, green, blue : LONGREAL); 76 | BEGIN 77 | setSourceRGB(self.cairo, red, green, blue); 78 | END SetSourceRGB; 79 | 80 | PROCEDURE -setSourceRGBA* (cairo : Cairo; red, green, blue, alpha : LONGREAL) 81 | "cairo_set_source_rgba((cairo_t *) cairo, (double)red, (double)green, (double)blue, (double) alpha)"; 82 | 83 | PROCEDURE (self : Painter) SetSourceRGBA* (red, green, blue, alpha : LONGREAL); 84 | BEGIN 85 | setSourceRGBA(self.cairo, red, green, blue, alpha); 86 | END SetSourceRGBA; 87 | 88 | PROCEDURE -moveTo* (cairo : Cairo; x, y : LONGREAL) 89 | "cairo_move_to((cairo_t *) cairo, (double)x, (double)y)"; 90 | 91 | PROCEDURE (self : Painter) MoveTo* (x, y : LONGREAL); 92 | BEGIN 93 | moveTo(self.cairo, x, y); 94 | END MoveTo; 95 | 96 | PROCEDURE -relLineTo* (cairo : Cairo; dx, dy : LONGREAL) 97 | "cairo_rel_line_to((cairo_t *) cairo, (double)dx, (double)dy)"; 98 | 99 | PROCEDURE (self : Painter) RelLineTo* (x, y : LONGREAL); 100 | BEGIN 101 | relLineTo(self.cairo, x, y); 102 | END RelLineTo; 103 | 104 | PROCEDURE -lineTo* (cairo : Cairo; dx, dy : LONGREAL) 105 | "cairo_line_to((cairo_t *) cairo, (double)dx, (double)dy)"; 106 | 107 | PROCEDURE (self : Painter) LineTo* (x, y : LONGREAL); 108 | BEGIN 109 | lineTo(self.cairo, x, y); 110 | END LineTo; 111 | 112 | PROCEDURE -setLineWidth* (cairo : Cairo; width : LONGREAL) 113 | "cairo_set_line_width((cairo_t *) cairo, width)"; 114 | 115 | PROCEDURE (self : Painter) SetLineWidth* (width : LONGREAL); 116 | BEGIN 117 | setLineWidth(self.cairo, width); 118 | END SetLineWidth; 119 | 120 | PROCEDURE -getLineWidth* (cairo : Cairo) : LONGREAL 121 | "cairo_get_line_width((cairo_t *) cairo)"; 122 | 123 | PROCEDURE (self : Painter) GetLineWidth* () : LONGREAL; 124 | BEGIN 125 | RETURN getLineWidth(self.cairo); 126 | END GetLineWidth; 127 | 128 | PROCEDURE -arc* (cairo : Cairo; xc, yc, radius, angle1, angle2 : LONGREAL) 129 | "cairo_arc((cairo_t *) cairo, xc, yc, radius, angle1, angle2)"; 130 | 131 | PROCEDURE (self : Painter) Arc* (xc, yc, radius, angle1, angle2 : LONGREAL); 132 | BEGIN 133 | arc(self.cairo, xc, yc, radius, angle1, angle2); 134 | END Arc; 135 | 136 | PROCEDURE -rotate* (cairo : Cairo; angle : LONGREAL) 137 | "cairo_rotate((cairo_t *) cairo, (double)angle)"; 138 | 139 | PROCEDURE (self : Painter) Rotate* (angle : LONGREAL); 140 | BEGIN 141 | rotate(self.cairo, angle); 142 | END Rotate; 143 | 144 | PROCEDURE -closePath* (cairo : Cairo) 145 | "cairo_close_path((cairo_t *) cairo)"; 146 | 147 | PROCEDURE (self : Painter) ClosePath; 148 | BEGIN 149 | closePath(self.cairo); 150 | END ClosePath; 151 | 152 | PROCEDURE -rectangle* (cairo : Cairo; x, y, width, height : LONGREAL) 153 | "cairo_rectangle((cairo_t *) cairo, (double)x, (double)y, (double)width, (double)height)"; 154 | 155 | PROCEDURE (self : Painter) Rectangle* (x, y, width, height : LONGREAL); 156 | BEGIN 157 | rectangle(self.cairo, x, y, width, height); 158 | END Rectangle; 159 | 160 | PROCEDURE -setFillRule* (cairo : Cairo; fillRule : INTEGER) 161 | "cairo_set_fill_rule((cairo_t *) cairo, (cairo_fill_rule_t) fillRule)"; 162 | 163 | PROCEDURE (self : Painter) SetFillRule* (fillRule : INTEGER); 164 | BEGIN 165 | setFillRule(self.cairo, fillRule); 166 | END SetFillRule; 167 | 168 | PROCEDURE -fill* (cairo : Cairo) 169 | "cairo_fill((cairo_t *) cairo)"; 170 | 171 | PROCEDURE (self : Painter) Fill*; 172 | BEGIN 173 | fill(self.cairo); 174 | END Fill; 175 | 176 | PROCEDURE -stroke* (cairo : Cairo) 177 | "cairo_stroke((cairo_t *) cairo)"; 178 | 179 | PROCEDURE (self : Painter) Stroke*; 180 | BEGIN 181 | stroke(self.cairo); 182 | END Stroke; 183 | 184 | (* Text *) 185 | 186 | PROCEDURE -textExtents* (cairo : Cairo; text : ARRAY OF CHAR; VAR extents : TextExtents) 187 | "cairo_text_extents((cairo_t *) cairo, (const char *) text, (cairo_text_extents_t *) extents)"; 188 | 189 | PROCEDURE (self : Painter) TextExtents* (text : ARRAY OF CHAR; VAR extents : TextExtents); 190 | BEGIN 191 | textExtents(self.cairo, text, extents); 192 | END TextExtents; 193 | 194 | PROCEDURE -showText* (cairo : Cairo; text : ARRAY OF CHAR) 195 | "cairo_show_text((cairo_t *) cairo, (const char *) text)"; 196 | 197 | PROCEDURE (self : Painter) ShowText* (text : ARRAY OF CHAR); 198 | BEGIN 199 | showText(self.cairo, text); 200 | END ShowText; 201 | 202 | PROCEDURE -setFontSize* (cairo : Cairo; size : LONGREAL) 203 | "cairo_set_font_size((cairo_t *) cairo, (double)size)"; 204 | 205 | PROCEDURE (self : Painter) SetFontSize* (size : LONGREAL); 206 | BEGIN 207 | setFontSize(self.cairo, size); 208 | END SetFontSize; 209 | 210 | (* Save and restore state *) 211 | 212 | PROCEDURE -save* (cairo : Cairo) 213 | "cairo_save((cairo_t *) cairo)"; 214 | 215 | PROCEDURE (self : Painter) Save*; 216 | BEGIN 217 | save(self.cairo); 218 | END Save; 219 | 220 | PROCEDURE -restore* (cairo : Cairo) 221 | "cairo_restore((cairo_t *) cairo)"; 222 | 223 | PROCEDURE (self : Painter) Restore*; 224 | BEGIN 225 | restore(self.cairo); 226 | END Restore; 227 | 228 | (* Transforms *) 229 | 230 | PROCEDURE -translate* (cairo : Cairo; tx, ty : LONGREAL) 231 | "cairo_translate((cairo_t *) cairo, (double)tx, (double)ty)"; 232 | 233 | PROCEDURE (self : Painter) Translate* (tx, ty : LONGREAL); 234 | BEGIN 235 | translate(self.cairo, tx, ty); 236 | END Translate; 237 | 238 | PROCEDURE -scale* (cairo : Cairo; sx, sy : LONGREAL) 239 | "cairo_scale((cairo_t *) cairo, (double)sx, (double)sy)"; 240 | 241 | PROCEDURE (self : Painter) Scale* (sx, sy : LONGREAL); 242 | BEGIN 243 | scale(self.cairo, sx, sy); 244 | END Scale; 245 | 246 | PROCEDURE (self : Painter) Init* (cairo : Cairo); 247 | BEGIN 248 | self.cairo := cairo; 249 | END Init; 250 | 251 | END libCairo. 252 | -------------------------------------------------------------------------------- /src/lib/libPortAudio.ob2: -------------------------------------------------------------------------------- 1 | MODULE libPortAudio; 2 | 3 | (* OMAKE LINK "portaudio" *) 4 | 5 | (* H2O version 2002, ported to VOC 2020 [SG] *) 6 | (* DANGER! Should be regenerated *) 7 | 8 | (* Generated by H2O using "OOC" back-end *) 9 | 10 | (* H2O: Constants occuring in macros *) 11 | 12 | IMPORT SYSTEM, C := arC; 13 | 14 | CONST 15 | Float32* = 000000001H; 16 | Int16* = 000000002H; 17 | Int32* = 000000004H; 18 | Int24* = 000000008H; 19 | PackedInt24* = 000000010H; 20 | Int8* = 000000020H; 21 | UInt8* = 000000040H; 22 | CustomFormat* = 000010000H; 23 | NoDevice* = 0FFFFFFFFH; 24 | NoFlag* = 000000000H; 25 | ClipOff* = 000000001H; 26 | DitherOff* = 000000002H; 27 | PlatformSpecificFlags* = 000010000H; 28 | 29 | (* H2O: Constants occuring in enumerated types *) 30 | 31 | NoError* = 000000000H; 32 | HostError* = 0FFFFD8F0H; 33 | InvalidChannelCount* = 0FFFFD8F1H; 34 | InvalidSampleRate* = 0FFFFD8F2H; 35 | InvalidDeviceId* = 0FFFFD8F3H; 36 | InvalidFlag* = 0FFFFD8F4H; 37 | SampleFormatNotSupported* = 0FFFFD8F5H; 38 | BadIODeviceCombination* = 0FFFFD8F6H; 39 | InsufficientMemory* = 0FFFFD8F7H; 40 | BufferTooBig* = 0FFFFD8F8H; 41 | BufferTooSmall* = 0FFFFD8F9H; 42 | NullCallback* = 0FFFFD8FAH; 43 | BadStreamPtr* = 0FFFFD8FBH; 44 | TimedOut* = 0FFFFD8FCH; 45 | InternalError* = 0FFFFD8FDH; 46 | DeviceUnavailable* = 0FFFFD8FEH; 47 | 48 | (* H2O: Defined Type Names *) 49 | 50 | TYPE 51 | Address* = C.address (* void pointer *); 52 | 53 | (* String* = POINTER [CSTRING] TO ARRAY OF CHAR; *) 54 | 55 | String* = C.string; 56 | 57 | Error* = LONGINT; 58 | 59 | ErrorNum* = INTEGER (* enumerated type *); 60 | 61 | SampleFormat* = C.longint; 62 | 63 | DeviceID* = LONGINT; 64 | 65 | Time* = LONGREAL; 66 | DeviceInfo* = RECORD 67 | structVersion- : C.int; 68 | name- : String; 69 | maxInputChannels- : C.int; 70 | maxOutputChannels- :C.int; 71 | defaultLowInputLatency- : Time; 72 | defaultLowOutputLatency- : Time; 73 | defaultHighInputLatency- : Time; 74 | defaultHighOutputLatency- : Time; 75 | defaultSampleRate- : C.double; 76 | END; 77 | 78 | StreamCallbackTimeInfoPtr* = POINTER TO StreamCallbackTimeInfo; 79 | 80 | StreamCallbackTimeInfo* = RECORD 81 | inputBufferAdcTime- : Time; 82 | currentTime- : Time; 83 | outputBufferDacTime- : Time 84 | END; 85 | 86 | StreamCallbackFlags* = C.longint; 87 | 88 | StreamFlags* = C.longint; 89 | 90 | PtrDeviceInfo* = POINTER [notag] TO DeviceInfo; 91 | 92 | Stream* = C.address (* void pointer *); 93 | 94 | Callback* = PROCEDURE (inputBuffer : Address; outputBuffer : Address; framesPerBuffer : C.longint; outTime : StreamCallbackTimeInfoPtr; flags : StreamCallbackFlags; userData : Address) : C.int; 95 | 96 | HostApiIndex* = C.int; 97 | 98 | (* H2O: Defined structures / unions *) 99 | 100 | 101 | (* H2O: Procedure prototypes *) 102 | 103 | PROCEDURE -includePortAudio* "#include "; 104 | 105 | PROCEDURE -Initialize* () : Error 106 | "Pa_Initialize()"; 107 | 108 | PROCEDURE -Terminate* () : Error 109 | "Pa_Terminate()"; 110 | 111 | PROCEDURE -GetHostApiCount* () : HostApiIndex 112 | "Pa_GetHostApiCount()"; 113 | 114 | PROCEDURE -GetDefaultHostApi* () : HostApiIndex 115 | "Pa_GetDefaultHostApi()"; 116 | 117 | (* 118 | PROCEDURE -GetHostError* () : LONGINT; 119 | *) 120 | 121 | PROCEDURE -GetErrorText* (errnum : Error) : String 122 | "(arC_string) Pa_GetErrorText(errnum)"; 123 | 124 | (* 125 | PROCEDURE -CountDevices* () : LONGINT; 126 | PROCEDURE -GetDefaultInputDeviceID* () : DeviceID; 127 | PROCEDURE -GetDefaultOutputDeviceID* () : DeviceID; 128 | PROCEDURE -GetDeviceInfo* (device : DeviceID) : PtrDeviceInfo; 129 | PROCEDURE -OpenStream* (VAR stream [NIL_COMPAT] : Stream; inputDevice : DeviceID; numInputChannels : LONGINT; inputSampleFormat : SampleFormat; inputDriverInfo : Address; outputDevice : DeviceID; numOutputChannels : LONGINT; outputSampleFormat : SampleFormat; outputDriverInfo : Address; sampleRate : LONGREAL; framesPerBuffer : LONGINT; numberOfBuffers : LONGINT; streamFlags : StreamFlags; callback : Callback; userData : Address) : Error; 130 | *) 131 | PROCEDURE -OpenDefaultStream* (VAR stream : Stream; numInputChannels : LONGINT; numOutputChannels : LONGINT; sampleFormat : SampleFormat; sampleRate : LONGREAL; framesPerBuffer : LONGINT; callback : Callback; userData : Address) : Error 132 | "Pa_OpenDefaultStream((PaStream**) stream, numInputChannels, numOutputChannels, sampleFormat, sampleRate, framesPerBuffer, (PaStreamCallback *)callback, (void *)userData)"; 133 | 134 | PROCEDURE -CloseStream* (stream : Stream) : Error 135 | "Pa_CloseStream((PaStream *) stream)"; 136 | 137 | PROCEDURE -StartStream* (stream : Stream) : Error 138 | "Pa_StartStream((PaStream *) stream)"; 139 | 140 | PROCEDURE -StopStream* (stream : Stream) : Error 141 | "Pa_StopStream((PaStream *) stream)"; 142 | 143 | PROCEDURE -AbortStream* (stream : Stream) : Error 144 | "Pa_AbortStream((PaStream *) stream)"; 145 | 146 | PROCEDURE -StreamActive* (stream : Stream) : Error 147 | "Pa_StreamActive((PaStream *) stream)"; 148 | 149 | PROCEDURE -GetStreamTime* (stream : Stream) : Time 150 | "(PaTime)Pa_GetStreamTime((PaStream *) stream)"; 151 | 152 | PROCEDURE -GetStreamCpuLoad* (stream : Stream) : LONGREAL 153 | "Pa_GetStreamCpuLoad((PaStream *) stream)"; 154 | 155 | (* 156 | PROCEDURE -GetMinNumBuffers* (framesPerBuffer : LONGINT; sampleRate : LONGREAL) : LONGINT; 157 | *) 158 | PROCEDURE -Sleep* (msec : LONGINT) 159 | "Pa_Sleep((long) msec)"; 160 | (* 161 | PROCEDURE -GetSampleSize* (format : SampleFormat) : Error; 162 | *) 163 | 164 | END libPortAudio. 165 | -------------------------------------------------------------------------------- /src/lib/libPortMidi.ob2: -------------------------------------------------------------------------------- 1 | MODULE libPortMidi; 2 | 3 | (* OMAKE LINK "portmidi" *) 4 | 5 | IMPORT SYSTEM, C := arC; 6 | 7 | CONST 8 | noDeviceId* = -1; 9 | 10 | CONST 11 | filtActive* = ASH(1, 14); 12 | filtClock* = ASH(1, 8); 13 | filtSysEx* = ASH(1, 0); 14 | 15 | CONST 16 | true* = 1; 17 | false* = 0; 18 | 19 | TYPE 20 | DeviceID* = C.int; 21 | Error* = C.int; 22 | 23 | DeviceInfo* = POINTER [notag] TO DeviceInfoDesc; 24 | DeviceInfoDesc* = RECORD [notag] 25 | structVersion- : C.int; (* internal structure version *) 26 | interf- : C.string; (* underlying MIDI API, e.g. MMSystem or DirectX *) 27 | name- : C.string; (* device name, e.g. USB MidiSport 1x1 *) 28 | input- : C.int; (* true iff input is available *) 29 | output- : C.int; (* true iff output is availalble *) 30 | opened- : C.int; (* used by PortMidi code for error checking *) 31 | END; 32 | 33 | Stream* = POINTER [notag] TO RECORD [notag] END; 34 | 35 | Message* = C.int; 36 | Timestamp* = C.int; 37 | 38 | Event* = RECORD [notag] 39 | message- : Message; 40 | timestamp- : Timestamp; 41 | END; 42 | 43 | PROCEDURE -includePortMidi* "#include "; 44 | PROCEDURE -includePortTime* "#include "; 45 | 46 | PROCEDURE -Initialize* () : Error 47 | "Pm_Initialize()"; 48 | 49 | PROCEDURE -Terminate* () : Error 50 | "Pm_Terminate()"; 51 | 52 | PROCEDURE -GetDefaultInputDeviceID* () : DeviceID 53 | "Pm_GetDefaultInputDeviceID()"; 54 | 55 | PROCEDURE -CountDevices* () : LONGINT 56 | "Pm_CountDevices()"; 57 | 58 | PROCEDURE -GetDeviceInfo* (id : DeviceID) : DeviceInfo 59 | "(libPortMidi_DeviceInfo)Pm_GetDeviceInfo(id)"; 60 | 61 | PROCEDURE -OpenInput*(VAR stream : Stream; inputDevice : DeviceID; bufferSize : LONGINT) : Error 62 | "(PmError)Pm_OpenInput((PortMidiStream **)stream, (PmDeviceID)inputDevice, NULL, bufferSize, ((int32_t (*)(void *)) Pt_Time), NULL)"; 63 | 64 | PROCEDURE -OpenOutput*(VAR stream : Stream; outputDevice : DeviceID; bufferSize, latency : LONGINT) : Error 65 | "(PmError)Pm_OpenInput((PortMidiStream **)stream, (PmDeviceID)outputDevice, NULL, bufferSize, ((int32_t (*)(void *)) Pt_Time), NULL, latency)"; 66 | 67 | (* 68 | Close() closes a midi stream, flushing any pending buffers. (PortMidi 69 | attempts to close open streams when the application exits -- this is 70 | particularly difficult under Windows.) 71 | *) 72 | 73 | PROCEDURE -Close*(stream : Stream) : Error 74 | "(PmError)Pm_Close((PortMidiStream *)stream)"; 75 | 76 | (* 77 | Abort() terminates outgoing messages immediately The caller should 78 | immediately close the output port; this call may result in transmission of 79 | a partial midi message. There is no abort for Midi input because the user 80 | can simply ignore messages in the buffer and close an input device at any 81 | time. 82 | *) 83 | 84 | PROCEDURE -Abort*(stream : Stream) : Error 85 | "(PmError)Pm_Abort((PortMidiStream *)stream)"; 86 | 87 | PROCEDURE -SetFilter*(stream : Stream; filters : C.int) : Error 88 | "(PmError)Pm_SetFilter((PortMidiStream *)stream, filters)"; 89 | 90 | PROCEDURE -Poll*(stream : Stream) : Error 91 | "(PmError)Pm_Poll((PortMidiStream *)stream)"; 92 | 93 | PROCEDURE -Read*(stream : Stream; VAR buffer : ARRAY OF Event) : LONGINT 94 | "Pm_Read((PortMidiStream *)stream, (PmEvent*)buffer, (int32_t)buffer__len)"; 95 | 96 | PROCEDURE -Write*(stream : Stream; VAR buffer : ARRAY OF Event) : Error 97 | "(PmError)Pm_Write((PortMidiStream *)stream, (PmEvent*)buffer, (int32_t)buffer__len)"; 98 | 99 | PROCEDURE -MessageStatus*(msg : Message) : SHORTINT 100 | "Pm_MessageStatus(msg)"; 101 | 102 | PROCEDURE -MessageData1*(msg : Message) : SHORTINT 103 | "Pm_MessageData1(msg)"; 104 | 105 | PROCEDURE -MessageData2*(msg : Message) : SHORTINT 106 | "Pm_MessageData2(msg)"; 107 | 108 | END libPortMidi. 109 | -------------------------------------------------------------------------------- /src/lib/libSDL.ob2: -------------------------------------------------------------------------------- 1 | MODULE libSDL; 2 | 3 | (* OMAKE LINK "SDL2" *) 4 | 5 | IMPORT SYSTEM, C := arC; 6 | 7 | CONST 8 | windowAllowHighDPI* = 2000H; 9 | windowShown* = 0004H; 10 | 11 | CONST 12 | windowposUndefined* = 1FFF0000H; 13 | 14 | CONST 15 | initTimer*= 000001H; 16 | initAudio*= 000010H; 17 | initVideo*= 000020H; (* SDL_INIT_VIDEO implies SDL_INIT_EVENTS *) 18 | initJoystick*= 000200H; (* SDL_INIT_JOYSTICK implies SDL_INIT_EVENTS *) 19 | initHaptic*= 001000H; 20 | initGamecontroller*= 002000H; (* SDL_INIT_GAMECONTROLLER implies SDL_INIT_JOYSTICK *) 21 | initEvents*= 004000H; 22 | initSensor*= 008000H; 23 | initNoparachute*= 100000H; (* compatibility; this flag is ignored. *) 24 | 25 | CONST 26 | rendererSoftware* = 1; 27 | rendererAccelerated* = 2; 28 | rendererPresentVsync* = 4; 29 | rendererTargetTexture* = 8; 30 | 31 | CONST 32 | msgQuit* = 100H; 33 | msgMouseMotion* = 400H; 34 | msgMouseButtonDown* = 401H; 35 | msgMouseButtonUp* = 402H; 36 | msgMouseWheel* = 403H; 37 | msgKeyDown* = 300H; 38 | msgKeyUp* = 301H; 39 | msgTextInput* = 303H; 40 | 41 | CONST 42 | TextInputEventTextSize = 32; 43 | 44 | TYPE 45 | Uint8 = SYSTEM.INT8; (* should be unsigned *) 46 | Uint16 = SYSTEM.INT16; (* should be unsigned *) 47 | Uint32 = SYSTEM.INT32; (* should be unsigned *) 48 | Sint32 = SYSTEM.INT32; (* should be unsigned *) 49 | 50 | Window* = POINTER TO RECORD [notag] END; 51 | Texture* = POINTER TO RECORD [notag] END; 52 | Renderer* = POINTER TO RECORD [notag] END; 53 | 54 | Event* = RECORD [notag] (* FIXME! This is a massive UNION Type *) 55 | type* : C.int; 56 | guess : ARRAY 128 OF CHAR; 57 | END; 58 | 59 | MouseMotionEventPtr* = POINTER TO MouseMotionEvent; 60 | MouseMotionEvent* = RECORD [notag] 61 | type* : Uint32; 62 | timestamp* : Uint32; 63 | windowID* : Uint32; 64 | which* : Uint32; 65 | state : Uint32; 66 | x* : Sint32; 67 | y* : Sint32; 68 | xrel* : Sint32; 69 | yrel* : Sint32; 70 | END; 71 | 72 | MouseButtonEventPtr* = POINTER TO MouseButtonEvent; 73 | MouseButtonEvent* = RECORD [notag] 74 | type* : Uint32; 75 | timestamp* : Uint32; 76 | windowID* : Uint32; 77 | which* : Uint32; 78 | button* : Uint8; 79 | state* : Uint8; 80 | clicks* : Uint8; 81 | padding1 : Uint8; 82 | x* : Sint32; 83 | y* : Sint32; 84 | END; 85 | 86 | MouseWheelEventPtr* = POINTER TO MouseWheelEvent; 87 | MouseWheelEvent* = RECORD [notag] 88 | type* : Uint32; 89 | timestamp* : Uint32; 90 | windowID* : Uint32; 91 | which* : Uint32; 92 | x* : Sint32; 93 | y* : Sint32; 94 | direction* : Uint32; 95 | END; 96 | 97 | Keysym* = RECORD [notag] 98 | scancode* : Uint32; 99 | sym* : Uint32; 100 | mod* : Uint16; 101 | END; 102 | 103 | KeyboardEventPtr* = POINTER TO KeyboardEvent; 104 | KeyboardEvent* = RECORD [notag] 105 | type* : Uint32; 106 | timestamp* : Uint32; 107 | windowID* : Uint32; 108 | state* : Uint8; 109 | repeat* : Uint8; 110 | padding1, padding2* : Uint8; 111 | keysym* : Keysym; 112 | END; 113 | 114 | TextInputEventPtr* = POINTER TO TextInputEvent; 115 | TextInputEvent* = RECORD [notag] 116 | type* : Uint32; 117 | timestamp* : Uint32; 118 | windowID* : Uint32; 119 | text* : ARRAY [notag] TextInputEventTextSize OF CHAR; 120 | END; 121 | 122 | Color = RECORD [notag] 123 | r, g, b, a : Uint8; 124 | END; 125 | 126 | Palette = RECORD [notag] 127 | ncolors : C.int; 128 | colors : POINTER TO Color; 129 | version : Uint32; 130 | refcount : C.int; 131 | END; 132 | 133 | PixelFormat = RECORD [notag] 134 | format : Uint32; 135 | palette : POINTER TO Palette; 136 | BitsPerPixel : Uint8; 137 | BytesPerPixel : Uint8; 138 | padding : ARRAY 2 OF Uint8; (* assuming ALIGN1 *) 139 | Rmask, Gmask, Bmask, Amask : Uint32; 140 | Rloss, Gloss, Bloss, Aloss : Uint32; 141 | Rshift, Gshift, Bshift, Ashift : Uint32; 142 | refcount : C.int; 143 | next : POINTER TO PixelFormat; 144 | END; 145 | 146 | ImageData* = POINTER TO RECORD[notag] END; 147 | 148 | Surface* = POINTER TO RECORD [notag] 149 | flags- : C.int; 150 | format- : POINTER TO PixelFormat; 151 | w-, h- : C.int; 152 | pitch- : SYSTEM.INT16; 153 | pixels- : ImageData; 154 | offset : C.int; 155 | END; 156 | 157 | RectPtr = POINTER TO RECORD [notag] END; 158 | 159 | PROCEDURE -includeSDL* "#include "; 160 | 161 | PROCEDURE -CreateWindow*(title : ARRAY OF CHAR; x, y, w, h, flags : C.int) : Window 162 | "(libSDL_Window)SDL_CreateWindow((const char *)title, x, y, w, h, flags)"; 163 | 164 | PROCEDURE -Init*(flags : C.int) : C.int 165 | "(int)SDL_Init(flags)"; 166 | 167 | PROCEDURE -PollEvent*(VAR event : Event) : C.int 168 | "(int)SDL_PollEvent((SDL_Event *)event)"; 169 | 170 | PROCEDURE -Delay*(ms : C.int) 171 | "SDL_Delay(ms)"; 172 | 173 | PROCEDURE -Quit* 174 | "SDL_Quit()"; 175 | 176 | PROCEDURE -DestroyWindow*(window : Window) 177 | "SDL_DestroyWindow((SDL_Window *)window)"; 178 | 179 | PROCEDURE -DestroyTexture*(texture : Texture) 180 | "SDL_DestroyTexture((SDL_Texture *)texture)"; 181 | 182 | PROCEDURE -GetWindowSize*(window : Window; VAR width, height : C.int) 183 | "SDL_GetWindowSize((SDL_Window *)window, width, height)"; 184 | 185 | PROCEDURE -GetWindowID*(window : Window) : C.int 186 | "SDL_GetWindowID((SDL_Window *)window)"; 187 | 188 | PROCEDURE -CreateRenderer*(window : Window; index, flags : C.int) : Renderer 189 | "(libSDL_Renderer)SDL_CreateRenderer((SDL_Window *)window, (int)index, (int)flags)"; 190 | 191 | PROCEDURE -GetRendererOutputSize*(renderer : Renderer; VAR width, height : C.int) 192 | "SDL_GetRendererOutputSize((SDL_Renderer *)renderer, width, height)"; 193 | 194 | PROCEDURE -CreateRGBSurface*(flags, width, height, depth : C.int; rMask, gMask, bMask, aMask : C.int) : Surface 195 | "(libSDL_Surface)SDL_CreateRGBSurface(flags, width, height, depth, rMask, gMask, bMask, aMask)"; 196 | 197 | PROCEDURE -CreateTextureFromSurface*(renderer : Renderer; surface : Surface) : Texture 198 | "(libSDL_Texture)SDL_CreateTextureFromSurface((SDL_Renderer *) renderer, (SDL_Surface *)surface)"; 199 | 200 | PROCEDURE -RenderCopy*(renderer : Renderer; texture : Texture; srcRect, dstRect : RectPtr) 201 | "SDL_RenderCopy((SDL_Renderer *)renderer, (SDL_Texture *)texture, (const SDL_Rect *)srcRect, (const SDL_Rect *)dstRect)"; 202 | 203 | PROCEDURE -RenderPresent*(renderer : Renderer) 204 | "SDL_RenderPresent((SDL_Renderer *)renderer)"; 205 | 206 | END libSDL. 207 | -------------------------------------------------------------------------------- /src/tool/OEF.ob2: -------------------------------------------------------------------------------- 1 | (* Ofront+ Error Filter - Show error messages from the compiler in a 2 | human-readable format, including the source code position and context. 3 | 4 | This program parses messages from standard input (via Console) which will 5 | normally be piped from the compiler output. For example: 6 | 7 | ofront+ -2 -88 -m Module.Mod | OEF 8 | 9 | Parameters are: 10 | 11 | contextLines: (default: 1) 12 | The number of lines of source code to display before and after the error 13 | line Setting this to zero displays just the error line and message 14 | 15 | tabSize: (default: 2) 16 | Number of spaces per tab. Tabs are expanded by padding to the column that 17 | is the next multiple of the tab size. OEF will adjust the column pointer to 18 | account for tabs. 19 | 20 | width: (default: 80) 21 | By default the error message is shown after the position pointer, but when 22 | the error message is long, this can lead to bad formatting that wraps 23 | around to the next line. If it looks like the message will extend past 24 | , OEF will place the error message at the start of the next line. 25 | 26 | withLineNumbers: (default: TRUE) 27 | When enabled, line numbers are displayed in front of each source line. 28 | When disabled, line numbers are shown after the error message 29 | 30 | alwaysWrap: (default: FALSE) 31 | When true, error messages are always shown on a separate line. Normal 32 | behaviour is to only do this for very wide lines. See discussion of width 33 | above. 34 | 35 | showSeparators: (default: TRUE) 36 | When true, a separator is shown between distcontiguous source code lines. 37 | This normally happens between context blocks. 38 | *) 39 | 40 | (* SG 2020/08/21 *) 41 | 42 | MODULE OEF; 43 | 44 | IMPORT 45 | Kernel, 46 | Files, 47 | Console, 48 | 49 | Pattern := arPattern, 50 | Strings := arStrings, 51 | C := arConfiguration; 52 | 53 | TYPE 54 | String = Pattern.String; 55 | 56 | Message = POINTER TO RECORD 57 | line : INTEGER; 58 | column : INTEGER; 59 | code : INTEGER; 60 | text : String; 61 | next : Message; 62 | END; 63 | 64 | CONST 65 | filePattern = "* translating *"; 66 | messagePattern = " *:* err * *"; 67 | TAB = 9X; 68 | 69 | VAR 70 | (* number of lines of source code context to show before and after error line *) 71 | contextLines : C.Integer; 72 | 73 | (* number of spaces equivalent to one tab *) 74 | tabSize : C.Integer; 75 | 76 | (* show a separator at discontinuities between context blocks *) 77 | showSeparators : C.Boolean; 78 | 79 | (* TRUE to always show error message on a separate line. Otherwise, it will be appended to the column pointer if there is room *) 80 | alwaysWrap : C.Boolean; 81 | 82 | (* Nominal display width, to control wrapping *) 83 | width : C.Integer; 84 | 85 | (* display line numbers for source lines *) 86 | withLineNumbers : C.Boolean; 87 | 88 | PROCEDURE Min(x, y : INTEGER) : INTEGER; 89 | BEGIN 90 | IF x < y THEN RETURN x ELSE RETURN y END; 91 | END Min; 92 | 93 | PROCEDURE Max(x, y : INTEGER) : INTEGER; 94 | BEGIN 95 | IF x > y THEN RETURN x ELSE RETURN y END; 96 | END Max; 97 | 98 | (* convert string to integer *) 99 | 100 | PROCEDURE StringToInt(VAR s : ARRAY OF CHAR) : INTEGER; 101 | VAR value, i : INTEGER; ch : CHAR; 102 | BEGIN 103 | value := 0; 104 | i := 0; ch := s[i]; 105 | WHILE (ch >= '0') & (ch <= '9') DO 106 | value := value * 10 + ORD(ch) - ORD('0'); 107 | INC(i); ch := s[i]; 108 | END; 109 | RETURN value; 110 | END StringToInt; 111 | 112 | (* conditionally output string *) 113 | 114 | PROCEDURE CondOutString(condition : BOOLEAN; string : ARRAY OF CHAR); 115 | BEGIN 116 | IF condition THEN 117 | Console.String(string); 118 | END; 119 | END CondOutString; 120 | 121 | (* Read line from file, and return FALSE at end of input *) 122 | 123 | PROCEDURE ReadLineFromFile(VAR line : ARRAY OF CHAR; VAR rd : Files.Rider) : BOOLEAN; 124 | VAR 125 | i : INTEGER; 126 | ch : CHAR; 127 | BEGIN 128 | i := 0; 129 | Files.ReadChar(rd, ch); 130 | IF ch = 0X THEN RETURN FALSE END; 131 | WHILE (ch # 0AX) & (ch # 0X) DO 132 | IF (ch # 0DX) & (i < LEN(line)-1) THEN 133 | line[i] := ch; INC(i); 134 | END; 135 | Files.ReadChar(rd, ch); 136 | END; 137 | line[i] := 0X; 138 | RETURN TRUE; 139 | END ReadLineFromFile; 140 | 141 | (* Read line of input from stdin, and return FALSE at end of input *) 142 | (* FIXME: Avoid duplication by reading STDIN via Files.Rider if possible? *) 143 | 144 | PROCEDURE ReadLineFromStdin(VAR line : ARRAY OF CHAR) : BOOLEAN; 145 | VAR 146 | i : INTEGER; 147 | ch : CHAR; 148 | BEGIN 149 | i := 0; 150 | Console.Read(ch); 151 | IF ch = 0X THEN RETURN FALSE END; 152 | WHILE (ch # 0AX) & (ch # 0X) DO 153 | IF (ch # 0DX) & (i < LEN(line)-1) THEN 154 | line[i] := ch; INC(i); 155 | END; 156 | Console.Read(ch); 157 | END; 158 | line[i] := 0X; 159 | RETURN TRUE; 160 | END ReadLineFromStdin; 161 | 162 | (* Insert message in list, ordered by line and column *) 163 | 164 | PROCEDURE InsertMessage(list, item : Message); 165 | BEGIN 166 | WHILE (list.next # NIL) & ((list.next.line < item.line) OR ((list.next.line = item.line) & (list.next.column < item.column))) DO 167 | list := list.next; 168 | END; 169 | item.next := list.next; 170 | list.next := item; 171 | END InsertMessage; 172 | 173 | (* Emit a line of source from , expanding any tabs. Output the 174 | horizontal character position for each column number in original 175 | source line. *) 176 | 177 | PROCEDURE EmitLine(VAR buffer : ARRAY OF CHAR; VAR position : ARRAY OF INTEGER); 178 | VAR i, pos : INTEGER; ch : CHAR; 179 | BEGIN 180 | i := 0; pos := 0; ch := buffer[i]; 181 | WHILE ch # 0X DO 182 | position[i] := pos; 183 | IF ch = TAB THEN 184 | Console.Char(' '); INC(pos); 185 | WHILE pos MOD tabSize.value # 0 DO 186 | Console.Char(' '); INC(pos); 187 | END; 188 | ELSE 189 | Console.Char(ch); INC(pos); 190 | END; 191 | INC(i); ch := buffer[i]; 192 | END; 193 | Console.Ln; 194 | END EmitLine; 195 | 196 | (* Emit an arrow pointing to . *) 197 | 198 | PROCEDURE EmitArrow(position : INTEGER; body, tip : CHAR); 199 | VAR i : INTEGER; ch : CHAR; 200 | BEGIN 201 | DEC(position); 202 | WHILE position > 0 DO 203 | DEC(position); Console.Char(body); 204 | END; 205 | Console.Char(tip); 206 | END EmitArrow; 207 | 208 | (* Emit messages with context lines from original source file. 209 | defines the number of additional source lines displayed before and 210 | after the message line. *) 211 | 212 | PROCEDURE ProcessFile(fileName : ARRAY OF CHAR; message : Message); 213 | CONST 214 | maxLineLength = 128; 215 | VAR 216 | line : INTEGER; 217 | trailingContext : INTEGER; 218 | buffer : ARRAY maxLineLength OF CHAR; 219 | position : ARRAY maxLineLength OF INTEGER; 220 | rd : Files.Rider; 221 | file : Files.File; 222 | needSeparator : BOOLEAN; 223 | columnPosition : INTEGER; 224 | BEGIN 225 | trailingContext := 0; 226 | needSeparator := FALSE; 227 | file := Files.Old(fileName); 228 | IF file = NIL THEN 229 | Console.String("Cannot open file: "); Console.String(fileName); Console.Ln; 230 | RETURN 231 | END; 232 | Files.Set(rd, file, 0); 233 | line := 0; 234 | WHILE ReadLineFromFile(buffer, rd) DO 235 | INC(line); 236 | (* look-ahead for leading context lines *) 237 | IF (line <= trailingContext) OR ((message # NIL) & (ABS(line-message.line)<=contextLines.value)) THEN 238 | IF (line > trailingContext) & needSeparator THEN 239 | (* output a separator after trailing context *) 240 | needSeparator := FALSE; 241 | CondOutString(withLineNumbers.value, "-----"); 242 | Console.Ln; 243 | END; 244 | (* emit the source line *) 245 | IF withLineNumbers.value THEN 246 | (* formatting assumes < 10000 source lines *) 247 | Console.Int(line, 4); Console.String("| "); 248 | END; 249 | EmitLine(buffer, position); 250 | (* now emit message lines. May be multiple messages per line *) 251 | WHILE (message # NIL) & (message.line = line) DO 252 | trailingContext := line + contextLines.value; 253 | needSeparator := showSeparators.value; 254 | CondOutString(withLineNumbers.value, " +-"); 255 | columnPosition := position[Max(0, Min(LEN(position)-1, message.column-1))]; 256 | EmitArrow(columnPosition, '-', '^'); 257 | (* if message will wrap awkwardly after arrow, start on a new line *) 258 | IF ~alwaysWrap.value & (columnPosition + Strings.Length(message.text^) + 7 < width.value) THEN 259 | Console.String(" "); 260 | ELSE 261 | Console.Ln; 262 | CondOutString(withLineNumbers.value, " | "); 263 | END; 264 | Console.String(message.text^); 265 | IF ~withLineNumbers.value THEN 266 | Console.String(" @"); Console.Int(message.line, 0); 267 | Console.String(":"); Console.Int(message.column, 0); 268 | END; 269 | Console.Ln; 270 | message := message.next; 271 | END; 272 | END; 273 | END; 274 | Files.Close(file); 275 | END ProcessFile; 276 | 277 | (* Process input, normally piped from the compiler output *) 278 | 279 | PROCEDURE ProcessInput; 280 | VAR 281 | line : ARRAY 128 OF CHAR; 282 | fileName : Pattern.String; 283 | match : Pattern.StringArray; 284 | message, list : Message; 285 | BEGIN 286 | (* Note: message list has dummy header node to facilitate insertion *) 287 | NEW(list); list.next := NIL; 288 | fileName := NIL; 289 | 290 | WHILE ReadLineFromStdin(line) DO 291 | IF Pattern.Match(filePattern, line, match) THEN 292 | (* when file changes, emit any previous messages first *) 293 | IF (fileName # NIL) & (list.next # NIL) THEN 294 | ProcessFile(fileName^, list.next); 295 | NEW(list); list.next := NIL; 296 | END; 297 | (* now set the new file *) 298 | fileName := match[0]; 299 | Console.String(line); Console.Ln; 300 | ELSIF Pattern.Match(messagePattern, line, match) THEN 301 | NEW(message); 302 | message.line := StringToInt(match[0]^); 303 | message.column := StringToInt(match[1]^); 304 | message.code := StringToInt(match[2]^); 305 | message.text := match[3]; 306 | message.text[0] := CAP(message.text[0]); 307 | InsertMessage(list, message); 308 | ELSE 309 | Console.String(line); Console.Ln; 310 | END; 311 | END; 312 | IF fileName # NIL THEN 313 | ProcessFile(fileName^, list.next); 314 | END; 315 | END ProcessInput; 316 | 317 | PROCEDURE Options; 318 | VAR pos : LONGINT; 319 | BEGIN 320 | withLineNumbers := 321 | C.NewBoolean("numbers", "Show line numbers before source lines", TRUE); 322 | alwaysWrap := 323 | C.NewBoolean("wrap", "Always show error message on separate line", FALSE); 324 | showSeparators := 325 | C.NewBoolean("separate", "Separate discontiguous source lines", TRUE); 326 | contextLines := 327 | C.NewInteger("context ", "Show context lines before and after message", 1, 0, 10); 328 | tabSize := 329 | C.NewInteger("tabs ", "Set spaces per tab character", 2, 1, C.None); 330 | width := 331 | C.NewInteger("width ", "Wrap messages extending past column ", 80, 40, C.None); 332 | IF C.ReadOptions("oef.ini") THEN 333 | (* Console.String("Read parameters from file"); Console.Ln; *) 334 | END; 335 | pos := 1; 336 | C.ScanOptions(pos); 337 | C.CheckFinished(pos); 338 | END Options; 339 | 340 | BEGIN 341 | C.SetBanner("oef - Ofront+ Error Filter\nThis tool shows source code context for Ofront+ compiler messages\nUsage:\n ofront+ ... Module.Mod | oef [options]\n"); 342 | Options; 343 | ProcessInput; 344 | END OEF. 345 | -------------------------------------------------------------------------------- /src/tool/OMake.ob2: -------------------------------------------------------------------------------- 1 | MODULE OMake; 2 | 3 | IMPORT 4 | Kernel, 5 | Console, 6 | Files, 7 | Platform, 8 | Out := arOut, 9 | 10 | Path := arPath, 11 | Char := arChar, 12 | Text := arText, 13 | Pattern := arPattern, 14 | C := arConfiguration, 15 | SL := arStringList, 16 | SA := arStringAssoc, 17 | Strings := arStrings; 18 | 19 | CONST 20 | eof = 0; 21 | identifier = 1; 22 | string = 2; 23 | 24 | comma = 100; 25 | semicolon = 101; 26 | colon = 102; 27 | becomes = 103; 28 | leftParenthesis = 104; 29 | rightParenthesis = 105; 30 | openComment = 106; 31 | closeComment = 107; 32 | times = 108; 33 | leftSquareBracket = 109; 34 | rightSquareBracket = 110; 35 | 36 | module = 200; 37 | import = 201; 38 | 39 | link = 300; 40 | 41 | TYPE 42 | StringList = SL.List; 43 | StringArray = SL.Array; 44 | String = SL.String; 45 | 46 | Keyword = POINTER TO RECORD 47 | name : String; 48 | symbol : INTEGER; 49 | next : Keyword; 50 | END; 51 | 52 | Import = POINTER TO RECORD 53 | name : String; 54 | module : Module; 55 | next : Import; 56 | END; 57 | 58 | Module = POINTER TO RECORD 59 | name : String; 60 | file : String; 61 | inLibrary : BOOLEAN; 62 | isForeign : BOOLEAN; 63 | built : BOOLEAN; 64 | flags : String; (* flags specified in module *) 65 | extFlags : String; (* flags infered from extension *) 66 | links : StringList; 67 | imports : Import; 68 | next : Module; 69 | END; 70 | 71 | VAR 72 | path : C.String; 73 | exclude : C.String; 74 | require : C.String; 75 | debug : C.Boolean; 76 | script : C.Boolean; 77 | compiler : C.String; 78 | linker : C.String; 79 | libraries : C.Assoc; 80 | linkFlags : C.Assoc; 81 | extensions : C.Assoc; 82 | builtin : C.Assoc; 83 | 84 | sPath : StringArray; 85 | sExclude : StringArray; 86 | sRequire : StringArray; 87 | modules : Module; 88 | keywords, makeKeywords : Keyword; 89 | 90 | PROCEDURE AddSymbol(name : ARRAY OF CHAR; symbol : INTEGER); 91 | VAR keyword : Keyword; 92 | BEGIN 93 | NEW(keyword); 94 | keyword.name := SL.Copy(name); 95 | keyword.symbol := symbol; 96 | keyword.next := keywords; 97 | keywords := keyword; 98 | END AddSymbol; 99 | 100 | PROCEDURE LocateModule(name : ARRAY OF CHAR; VAR result : String; VAR library : String); 101 | VAR 102 | i, j : LONGINT; 103 | fileName, path, ext : String; 104 | buffer : Text.Buffer; 105 | item : SA.Assoc; 106 | BEGIN 107 | buffer.Init(64); 108 | 109 | FOR i := 0 TO LEN(sPath^)-1 DO 110 | path := sPath[i]; 111 | library := SA.GetKey(libraries.value, path^); 112 | item := extensions.value; 113 | WHILE item # NIL DO 114 | ext := item.key; 115 | 116 | buffer.Clear; 117 | buffer.String(path^); 118 | buffer.String(Platform.PathDelimiter); 119 | buffer.String(name); 120 | buffer.String("."); 121 | buffer.String(ext^); 122 | fileName := buffer.GetString(); 123 | 124 | IF Platform.FileExists(fileName^) THEN 125 | result := fileName; 126 | RETURN; 127 | END; 128 | item := item.next 129 | END 130 | END; 131 | result := NIL; 132 | END LocateModule; 133 | 134 | PROCEDURE FindModule(name : ARRAY OF CHAR) : Module; 135 | VAR m : Module; 136 | BEGIN 137 | m := modules; 138 | WHILE m # NIL DO 139 | IF Strings.Equal(m.name^, name) THEN 140 | RETURN m; 141 | END; 142 | m := m.next; 143 | END; 144 | RETURN NIL; 145 | END FindModule; 146 | 147 | PROCEDURE ShowModule(m : Module ); 148 | VAR 149 | i : Import; 150 | l : StringList; 151 | BEGIN 152 | Console.String("MODULE "); Console.String(m.name^); 153 | IF m.flags # NIL THEN 154 | Console.String(" FLAGS '"); Console.String(m.flags^); Console.String("'"); 155 | END; 156 | IF m.imports # NIL THEN 157 | Console.String(" IMPORTS "); 158 | i := m.imports; 159 | WHILE i # NIL DO 160 | Console.String(i.name^); 161 | i := i.next; 162 | IF i # NIL THEN Console.Char(",") END; 163 | END; 164 | END; 165 | IF m.links # NIL THEN 166 | l := m.links; 167 | Console.String(" LINKS "); 168 | WHILE l # NIL DO 169 | Console.String(l.name^); 170 | l := l.next; 171 | IF l # NIL THEN Console.Char(","); END; 172 | END; 173 | END; 174 | Console.String(" IN FILE "); Console.String(m.file^); 175 | Console.Ln; 176 | END ShowModule; 177 | 178 | PROCEDURE ShowAllModules; 179 | VAR m : Module; 180 | BEGIN 181 | m := modules; 182 | WHILE m # NIL DO 183 | ShowModule(m); 184 | m := m.next; 185 | END; 186 | END ShowAllModules; 187 | 188 | PROCEDURE CheckFileType(path : String; VAR flags : String); 189 | VAR extension : ARRAY 32 OF CHAR; 190 | BEGIN 191 | Path.ExtName(path^, extension); 192 | Strings.Extract(extension, 1, LEN(extension), extension); 193 | flags := SA.Get(extensions.value, extension); 194 | END CheckFileType; 195 | 196 | PROCEDURE ParseFile(fileName : String) : Module; 197 | VAR 198 | line, column : INTEGER; 199 | rd : Files.Rider; 200 | file : Files.File; 201 | 202 | sym : INTEGER; ch : CHAR; 203 | 204 | ident : Text.Buffer; 205 | 206 | importName : String; 207 | library : String; 208 | m : Module; 209 | imp : Import; 210 | 211 | PROCEDURE ErrorString(reason, str : ARRAY OF CHAR); 212 | BEGIN 213 | IF line > 0 THEN 214 | Console.String("At line="); Console.Int(line, 0); 215 | Console.String(", column="); Console.Int(column, 0); 216 | Console.String(" in file "); Console.String(fileName^); 217 | Console.Ln; 218 | END; 219 | 220 | Console.String("ERROR: "); 221 | Console.String(reason); 222 | IF str[0] # 0X THEN 223 | Console.String(" : "); 224 | Console.String(str); 225 | END; 226 | Console.Ln; 227 | Kernel.Exit(1); 228 | END ErrorString; 229 | 230 | PROCEDURE Error(reason : ARRAY OF CHAR); 231 | BEGIN 232 | ErrorString(reason, ""); 233 | END Error; 234 | 235 | PROCEDURE Next; 236 | BEGIN 237 | IF ch = 0AX THEN 238 | column := 0; 239 | INC(line); 240 | END; 241 | Files.ReadChar(rd, ch); 242 | INC(column); 243 | END Next; 244 | 245 | PROCEDURE Ident; 246 | BEGIN 247 | ident.Clear; 248 | REPEAT 249 | ident.Char(ch); 250 | Next; 251 | UNTIL ~Char.IsLetter(ch) & ~Char.IsDigit(ch); 252 | ident.Terminate; 253 | sym := identifier; 254 | END Ident; 255 | 256 | PROCEDURE CopyIdent() : String; 257 | BEGIN 258 | RETURN SL.Copy(ident.value^); 259 | END CopyIdent; 260 | 261 | PROCEDURE CheckKeyword; 262 | VAR keyword : Keyword; 263 | BEGIN 264 | keyword := keywords; 265 | WHILE keyword # NIL DO 266 | IF Strings.Equal(keyword.name^, ident.value^) THEN 267 | sym := keyword.symbol; RETURN 268 | END; 269 | keyword := keyword.next; 270 | END; 271 | END CheckKeyword; 272 | 273 | PROCEDURE ParseString(term : CHAR); 274 | BEGIN 275 | Next; 276 | ident.Clear; 277 | WHILE ch # term DO 278 | IF (ch = 0X) OR (ch = 0AX) THEN 279 | Error("Unterminated String"); 280 | END; 281 | ident.Char(ch); 282 | Next; 283 | END; 284 | ident.Terminate; 285 | Next; 286 | sym := string; 287 | END ParseString; 288 | 289 | PROCEDURE SkipSpace; 290 | BEGIN 291 | WHILE Char.IsSpace(ch) DO Next; END; 292 | END SkipSpace; 293 | 294 | PROCEDURE Symbol0; 295 | BEGIN 296 | SkipSpace; 297 | CASE ch OF 298 | | 0X: sym := eof; 299 | | "a".."z", "A".."Z", "_": 300 | Ident; 301 | CheckKeyword; 302 | | '"': ParseString('"') 303 | | "'": ParseString("'") 304 | | ';': sym := semicolon; Next; 305 | | ',': sym := comma; Next; 306 | | ':': 307 | sym := colon; Next; 308 | IF ch = '=' THEN 309 | Next; 310 | sym := becomes; 311 | END; 312 | | '(': sym := leftParenthesis; Next; 313 | IF ch = '*' THEN 314 | sym := openComment; Next; 315 | END; 316 | | ')': sym := rightParenthesis; Next; 317 | | '[': sym := leftSquareBracket; Next; 318 | | ']': sym := rightSquareBracket; Next; 319 | | '*': sym := times; Next; 320 | IF ch = ')' THEN 321 | sym := closeComment; Next; 322 | END; 323 | ELSE 324 | Error("Unexpected symbol"); 325 | END; 326 | IF debug.value THEN 327 | Console.Int(sym, 0); Console.Ln; 328 | END; 329 | END Symbol0; 330 | 331 | PROCEDURE SkipComment; 332 | VAR 333 | lastCh : CHAR; 334 | level : INTEGER; 335 | BEGIN 336 | level := 1; 337 | lastCh := 0X; 338 | LOOP 339 | IF (ch = ')') & (lastCh = '*') THEN 340 | DEC(level); 341 | IF level = 0 THEN 342 | Next; RETURN; 343 | END; 344 | ELSIF (ch = '*') & (lastCh = '(') THEN 345 | INC(level); 346 | Next; 347 | END; 348 | lastCh := ch; 349 | Next; 350 | END; 351 | END SkipComment; 352 | 353 | PROCEDURE Symbol; 354 | BEGIN 355 | Symbol0; 356 | WHILE sym = openComment DO 357 | SkipComment; 358 | Symbol0; 359 | END; 360 | END Symbol; 361 | 362 | PROCEDURE Expect(symbol : INTEGER); 363 | BEGIN 364 | IF sym # symbol THEN 365 | Console.String("Expected="); Console.Int(symbol, 0); Console.String(" Found="); Console.Int(sym, 0); Console.Ln; 366 | Error("Unexpected symbol"); 367 | END; 368 | END Expect; 369 | 370 | PROCEDURE ParseImport(m : Module); 371 | VAR 372 | i : Import; 373 | name : String; 374 | BEGIN 375 | Expect(identifier); 376 | name := CopyIdent(); 377 | Symbol; 378 | IF sym = becomes THEN 379 | Symbol; 380 | Expect(identifier); 381 | name := CopyIdent(); 382 | Symbol; 383 | END; 384 | NEW(i); 385 | i.name := name; 386 | i.next := m.imports; 387 | m.imports := i; 388 | END ParseImport; 389 | 390 | PROCEDURE ParseLink(m : Module); 391 | BEGIN 392 | Expect(string); 393 | SL.Add(m.links, CopyIdent()); 394 | Symbol0; 395 | END ParseLink; 396 | 397 | PROCEDURE ParseMake(m : Module); 398 | BEGIN 399 | IF sym = string THEN 400 | m.flags := CopyIdent(); 401 | Symbol0; 402 | END; 403 | 404 | IF sym = link THEN 405 | Symbol0; 406 | ParseLink(m); 407 | WHILE sym = comma DO 408 | Symbol0; 409 | ParseLink(m); 410 | END; 411 | END; 412 | END ParseMake; 413 | 414 | PROCEDURE ParseModule(m : Module); 415 | VAR original : Keyword; 416 | BEGIN 417 | Expect(module); 418 | Symbol; 419 | IF sym = leftSquareBracket THEN 420 | (* if module flags are specified, check for "foreign", ignoring other flags *) 421 | Symbol; 422 | Expect(identifier); 423 | IF Strings.Equal(ident.value^, "foreign") THEN 424 | m.isForeign := TRUE; 425 | END; 426 | Symbol; 427 | Expect(rightSquareBracket); 428 | Symbol; 429 | END; 430 | Expect(identifier); 431 | m.name := CopyIdent(); 432 | Symbol; Expect(semicolon); 433 | 434 | (* comments after the module header may be OMAKE commands *) 435 | Symbol0; 436 | WHILE sym = openComment DO 437 | SkipSpace; 438 | IF ch = "O" THEN 439 | Ident; 440 | IF Strings.Equal(ident.value^, "OMAKE") THEN 441 | (* push new keyword set *) 442 | original := keywords; 443 | keywords := makeKeywords; 444 | 445 | Symbol0; 446 | ParseMake(m); 447 | Expect(closeComment); 448 | 449 | (* restore original keywords set *) 450 | keywords := original; 451 | ELSE 452 | SkipComment; 453 | END; 454 | Symbol0; 455 | ELSE 456 | SkipComment; 457 | Symbol0; 458 | END; 459 | END; 460 | 461 | (* parse imports *) 462 | IF sym = import THEN 463 | Symbol; 464 | ParseImport(m); 465 | WHILE sym = comma DO 466 | Symbol; 467 | ParseImport(m); 468 | END; 469 | Expect(semicolon); 470 | END; 471 | (* ignore the rest of the module *) 472 | END ParseModule; 473 | 474 | BEGIN 475 | ident.Init(64); 476 | 477 | IF debug.value THEN 478 | Console.String("Parse file "); Console.String(fileName^); Console.Ln; 479 | END; 480 | m := NIL; 481 | line := 0; column := 0; 482 | file := Files.Old(fileName^); 483 | IF file = NIL THEN 484 | ErrorString("Cannot open file", fileName^); 485 | END; 486 | Files.Set(rd, file, 0); 487 | ch := 0AX; 488 | Symbol; 489 | 490 | NEW(m); 491 | m.name := NIL; 492 | m.file := fileName; 493 | m.flags := NIL; 494 | CheckFileType(m.file, m.extFlags); 495 | m.links := NIL; 496 | m.imports := NIL; 497 | m.inLibrary := FALSE; 498 | m.isForeign := FALSE; 499 | m.built := FALSE; 500 | 501 | ParseModule(m); 502 | Files.Close(file); 503 | imp := m.imports; 504 | WHILE imp # NIL DO 505 | IF ~SL.ArrayContains(sExclude, imp.name) THEN 506 | imp.module := FindModule(imp.name^); 507 | IF imp.module = NIL THEN 508 | LocateModule(imp.name^, importName, library); 509 | IF importName = NIL THEN 510 | ErrorString("Cannot locate module source", imp.name^); 511 | END; 512 | imp.module := ParseFile(importName); 513 | IF library # NIL THEN 514 | SL.Add(imp.module.links, library); 515 | imp.module.inLibrary := TRUE; 516 | END; 517 | END; 518 | END; 519 | imp := imp.next; 520 | END; 521 | m.next := modules; 522 | modules := m; 523 | RETURN m; 524 | END ParseFile; 525 | 526 | (* execute command, or if -script specified just print *) 527 | 528 | PROCEDURE Run(command : String) : LONGINT; 529 | VAR result : LONGINT; i : LONGINT; ch : CHAR; 530 | BEGIN 531 | IF script.value THEN 532 | Console.String(command^); Console.Ln; 533 | RETURN 0; 534 | ELSE 535 | Console.String("--> "); Console.String(command^); Console.Ln; 536 | RETURN Platform.System(command^); 537 | END; 538 | END Run; 539 | 540 | PROCEDURE CompileModule(module : Module; VAR libs, objs : StringList; main : BOOLEAN) : BOOLEAN; 541 | VAR 542 | buffer : Text.Buffer; 543 | result : LONGINT; 544 | import : Import; 545 | BEGIN 546 | IF module.built THEN RETURN TRUE END; 547 | 548 | (* include link libraries for this module *) 549 | SL.Merge(module.links, libs); 550 | 551 | (* don't compile modules that are already in libraries *) 552 | IF module.inLibrary THEN 553 | RETURN TRUE; 554 | END; 555 | 556 | (* include this module in object files, except for foreign modules *) 557 | IF ~module.isForeign THEN 558 | SL.Add(objs, module.name); 559 | END; 560 | 561 | (* first compile all imported modules *) 562 | import := module.imports; 563 | WHILE import # NIL DO 564 | IF import.module # NIL THEN 565 | IF ~CompileModule(import.module, libs, objs, FALSE) THEN 566 | RETURN FALSE; 567 | END; 568 | END; 569 | import := import.next; 570 | END; 571 | 572 | (* now make a compile command for this module *) 573 | buffer.Init(128); 574 | 575 | buffer.String(compiler.value^); 576 | buffer.Char(" "); 577 | 578 | IF module.flags # NIL THEN 579 | buffer.String(module.flags^); 580 | buffer.Char(" "); 581 | END; 582 | IF module.extFlags # NIL THEN 583 | buffer.String(module.extFlags^); 584 | buffer.Char(" "); 585 | END; 586 | IF main THEN 587 | buffer.String("-m "); 588 | END; 589 | buffer.String(module.file^); 590 | 591 | (* compile the module *) 592 | IF ~script.value THEN 593 | Console.String("Building Module "); Console.String(module.name^); Console.Ln; 594 | END; 595 | result := Run(buffer.GetString()); 596 | 597 | module.built := TRUE; (* build attempted *) 598 | RETURN result = 0; 599 | END CompileModule; 600 | 601 | PROCEDURE LinkModule(module : Module; libs, objs : StringList) : BOOLEAN; 602 | VAR 603 | buffer : Text.Buffer; 604 | i, result : LONGINT; 605 | l, flag : StringList; 606 | name : String; 607 | omitLibs : StringList; 608 | BEGIN 609 | omitLibs := NIL; 610 | buffer.Init(128); 611 | buffer.String(linker.value^); 612 | buffer.String(" "); 613 | 614 | (* add any libraries specified by "require" directive *) 615 | IF sRequire # NIL THEN 616 | FOR i := 0 TO LEN(sRequire^)-1 DO 617 | SL.Include(libs, sRequire[i]); 618 | END 619 | END; 620 | 621 | (* output linkflags for all required libraries *) 622 | l := libs; 623 | WHILE l # NIL DO 624 | flag := SA.GetAll(linkFlags.value, l.name^); 625 | WHILE flag # NIL DO 626 | name := flag.name; 627 | IF Strings.Equal(name^, "NOLIB") THEN 628 | SL.Include(omitLibs, l.name); 629 | ELSE 630 | buffer.String(name^); buffer.Char(" "); 631 | END; 632 | flag := flag.next; 633 | END; 634 | l := l.next; 635 | END; 636 | 637 | (* include all object files *) 638 | l := objs; 639 | WHILE l # NIL DO 640 | buffer.String(l.name^); buffer.String(".c "); 641 | l := l.next; 642 | END; 643 | 644 | (* output name *) 645 | buffer.String("-o "); 646 | buffer.String(module.name^); 647 | buffer.Char(" "); 648 | 649 | (* include all necessary libraries *) 650 | l := libs; 651 | WHILE l # NIL DO 652 | IF ~SL.Contains(omitLibs, l.name) THEN 653 | buffer.String("-l"); 654 | buffer.String(l.name^); 655 | buffer.Char(" "); 656 | END; 657 | l := l.next; 658 | END; 659 | result := Run(buffer.GetString()); 660 | RETURN result = 0; 661 | END LinkModule; 662 | 663 | PROCEDURE BuildModule(module : Module); 664 | VAR 665 | libs, objs : StringList; 666 | BEGIN 667 | libs := NIL; 668 | objs := NIL; 669 | IF script.value THEN 670 | Console.String("# OMake generated script for "); 671 | Console.String(module.name^); 672 | Console.Ln; 673 | END; 674 | IF CompileModule(module, libs, objs, TRUE) THEN 675 | IF LinkModule(module, libs, objs) THEN 676 | END; 677 | END; 678 | END BuildModule; 679 | 680 | (* Process either a file name, or module name *) 681 | 682 | PROCEDURE ProcessFile(name : String) : Module; 683 | VAR 684 | file, library : String; 685 | module : Module; 686 | BEGIN 687 | IF Strings.LastIndexOf(name^, ".", -1) >= 0 THEN 688 | RETURN ParseFile(name); 689 | ELSE 690 | LocateModule(name^, file, library); 691 | IF file = NIL THEN 692 | Console.String("Cannot locate module source "); 693 | Console.String(name^); Console.Ln; 694 | Kernel.Exit(1); 695 | END; 696 | RETURN ParseFile(file) 697 | END; 698 | END ProcessFile; 699 | 700 | PROCEDURE Command; 701 | VAR 702 | pos : LONGINT; 703 | m : Module; 704 | BEGIN 705 | debug := C.NewBoolean("debug", "Debug output", FALSE); 706 | path := C.NewString("source", "Search path for Oberon source modules", ""); 707 | extensions := C.NewAssoc("extension", "Define compiler flags for accepted extensions", TRUE); 708 | exclude := C.NewString("exclude", "Don't parse these module sources", "Platform,SYSTEM"); 709 | require := C.NewString("require", "Libraries which must always be linked", "Ofront"); 710 | libraries := C.NewAssoc("lib", "Define library source location", FALSE); 711 | linkFlags := C.NewAssoc("linkflag", "Define linker flags for library", TRUE); 712 | compiler := C.NewString("compile", "Compile command", "Ofront+"); 713 | linker := C.NewString("link", "Link command", "gcc"); 714 | script := C.NewBoolean("script", "Generate script instead of building", FALSE); 715 | 716 | IF C.ReadOptions("omake.ini") THEN 717 | END; 718 | pos := 1; 719 | C.ScanOptions(pos); 720 | WHILE pos < LEN(C.argv^) DO 721 | sPath := Pattern.Split(path.value^, ","); 722 | sExclude := Pattern.Split(exclude.value^, ","); 723 | sRequire := Pattern.Split(require.value^, ","); 724 | m := ProcessFile(C.argv[pos]); 725 | BuildModule(m); 726 | INC(pos); 727 | C.ScanOptions(pos); 728 | END; 729 | C.CheckFinished(pos); 730 | END Command; 731 | 732 | BEGIN 733 | modules := NIL; 734 | libraries := NIL; 735 | 736 | (* keywords inside OMAKE directive *) 737 | keywords := NIL; 738 | AddSymbol("LINK", link); 739 | makeKeywords := keywords; 740 | 741 | (* standard Oberon keywords *) 742 | keywords := NIL; 743 | AddSymbol("MODULE", module); 744 | AddSymbol("IMPORT", import); 745 | 746 | Command; 747 | END OMake. 748 | -------------------------------------------------------------------------------- /test/HeapDebug.ob2: -------------------------------------------------------------------------------- 1 | (* 2 | Perform basic consistency checks on the Heap. 3 | 4 | Enumerates all Heap chunks, and all blocks within each chunk. 5 | Checks for inconsistencies, and optionally traps on error. 6 | Call HeapDebug.Check frequently, and use a debugger to catch the trap. 7 | 8 | Created 2020/08/13 - Stewart Greenhill 9 | *) 10 | 11 | MODULE HeapDebug; 12 | 13 | IMPORT 14 | Heap, 15 | S := SYSTEM, 16 | Out := Console; 17 | 18 | TYPE 19 | ADDRESS = S.ADRINT; 20 | 21 | VAR 22 | verbose : BOOLEAN; (* debug output which checking *) 23 | trap : BOOLEAN; (* trap immediately on any errors *) 24 | 25 | CONST 26 | SZA = SIZE(ADDRESS); (* Size of address *) 27 | 28 | (* heap chunks *) 29 | nextChnkOff = S.VAL(ADDRESS, 0); (* next heap chunk, sorted ascendingly! *) 30 | endOff = S.VAL(ADDRESS, SZA); (* end of heap chunk *) 31 | blkOff = S.VAL(ADDRESS, 3*SZA); (* first block in a chunk, starts with tag *) 32 | 33 | (* free heap blocks *) 34 | tagOff = S.VAL(ADDRESS, 0*SZA); (* any block starts with a tag *) 35 | sizeOff = S.VAL(ADDRESS, 1*SZA); (* block size in free block relative to block start *) 36 | sntlOff = S.VAL(ADDRESS, 2*SZA); (* pointer offset table sentinel in free block relative to block start *) 37 | nextOff = S.VAL(ADDRESS, 3*SZA); (* next pointer in free block relative to block start *) 38 | NoPtrSntl = S.VAL(ADDRESS, -SZA); 39 | 40 | PROCEDURE -Trap() 41 | "__builtin_trap()"; 42 | 43 | PROCEDURE -uLT(x, y: ADDRESS): BOOLEAN "((__U_ADRINT)x < (__U_ADRINT)y)"; 44 | PROCEDURE -uLE(x, y: ADDRESS): BOOLEAN "((__U_ADRINT)x <= (__U_ADRINT)y)"; 45 | 46 | PROCEDURE Error(reason : ARRAY OF CHAR; code : ADDRESS); 47 | BEGIN 48 | Out.String(reason); Out.String(" : "); Out.LongHex(code); Out.Ln; 49 | IF trap THEN 50 | Trap; 51 | END; 52 | END Error; 53 | 54 | (* determine if p points within heap *) 55 | 56 | PROCEDURE WithinHeap*(p : ADDRESS) : BOOLEAN; 57 | BEGIN 58 | RETURN uLE(Heap.heapMin, p) & uLT(p, Heap.heapMax); 59 | END WithinHeap; 60 | 61 | PROCEDURE Check*; 62 | VAR 63 | chunk, end, size, blockSize, tag, totalSize, tagSize, offset, nPointers : ADDRESS; 64 | block : ADDRESS; 65 | nChunks, nBlocks, nHeapBlocks, totalBlocks : LONGINT; 66 | isFree : BOOLEAN; 67 | name : ARRAY 24 OF CHAR; 68 | 69 | PROCEDURE GetName(adr : ADDRESS); 70 | BEGIN 71 | END GetName; 72 | 73 | PROCEDURE ShowChunk; 74 | BEGIN 75 | Out.String("Chunk #"); Out.Int(nChunks, 0); Out.Ln; 76 | Out.String(" Addr: "); Out.LongHex(chunk); Out.Ln; 77 | Out.String(" Size: "); Out.LongInt(size, 0); Out.String(" bytes"); Out.Ln; 78 | END ShowChunk; 79 | 80 | PROCEDURE ShowBlock; 81 | VAR i : LONGINT; pName : ADDRESS; ch : CHAR; 82 | BEGIN 83 | Out.String(" Block #"); Out.Int(nHeapBlocks, 0); 84 | Out.String(" Addr:"); Out.LongHex(block); 85 | Out.String(" Size:"); Out.LongInt(tagSize, 0); 86 | Out.String(" Ptrs:"); Out.LongInt(nPointers, 0); 87 | 88 | (* check if free block *) 89 | IF block + SZA = tag THEN 90 | Out.String(" Free"); 91 | 92 | (* Look for type name in statically allocated type descriptors. The 93 | t__desc.name field is not normally initialised by default, but type names can 94 | be enabled by adding the following line to __INITTYP in SYSTEM.Oh: 95 | 96 | strncpy(t##__desc.name, #t, sizeof(t##__desc.name)); \ 97 | *) 98 | ELSIF ~WithinHeap(tag) THEN 99 | pName := tag - 18 * SZA - 24; 100 | i := 0; 101 | LOOP 102 | IF i>= LEN(name)-1 THEN EXIT END; 103 | S.GET(pName, ch); 104 | IF ch = 0X THEN EXIT END; 105 | name[i] := ch; 106 | INC(i); INC(pName); 107 | END; 108 | name[i] := 0X; 109 | IF i > 0 THEN 110 | Out.String(" Type:"); Out.String(name); 111 | END; 112 | END; 113 | Out.Ln; 114 | END ShowBlock; 115 | 116 | PROCEDURE Summary; 117 | BEGIN 118 | Out.String("Chunks: "); Out.LongInt(nChunks, 0); Out.Ln; 119 | Out.String("Blocks: "); Out.LongInt(nHeapBlocks, 0); Out.Ln; 120 | Out.String("Total Size: "); Out.LongInt(totalSize, 0); 121 | Out.String(" (Heap.Mod reports "); Out.LongInt(Heap.heapsize, 0); 122 | Out.String(")"); Out.Ln; 123 | END Summary; 124 | 125 | PROCEDURE ShowLocation; 126 | BEGIN 127 | IF ~verbose THEN 128 | ShowChunk; ShowBlock; 129 | END; 130 | END ShowLocation; 131 | 132 | BEGIN 133 | nChunks := 0; 134 | nBlocks := 0; 135 | totalSize := 0; 136 | chunk := Heap.heap; 137 | WHILE chunk # 0 DO 138 | S.GET(chunk + endOff, end); 139 | size := end - chunk - blkOff; 140 | INC(totalSize, size); 141 | IF verbose THEN 142 | ShowChunk; 143 | END; 144 | 145 | block := chunk + blkOff; 146 | nHeapBlocks := 0; 147 | WHILE uLT(block, end) DO 148 | S.GET(block, tag); 149 | 150 | S.GET(tag, tagSize); 151 | 152 | IF tagSize = 0 THEN 153 | ShowLocation; 154 | Error("Invalid Tag Size", 0); 155 | END; 156 | 157 | (* read offset table, and check length *) 158 | nPointers := 0; 159 | LOOP 160 | INC(tag, SZA); 161 | S.GET(tag, offset); 162 | IF offset < 0 THEN EXIT END; 163 | INC(nPointers); 164 | END; 165 | 166 | IF nPointers * SZA + SZA # -offset THEN 167 | ShowLocation; 168 | Error("Invalid Sentinel", offset); 169 | END; 170 | 171 | IF verbose THEN 172 | ShowBlock; 173 | END; 174 | 175 | INC(block, tagSize); 176 | INC(nHeapBlocks); 177 | END; 178 | 179 | INC(nChunks); 180 | S.GET(chunk + nextChnkOff, chunk); 181 | END; 182 | 183 | IF verbose THEN 184 | Summary; 185 | END; 186 | IF totalSize # Heap.heapsize THEN 187 | Summary; 188 | Error("Inconsistent Heap Size", totalSize); 189 | END; 190 | END Check; 191 | 192 | (* Check that an address is within the heap and is not free*) 193 | 194 | PROCEDURE IsFreeBlock*(p : ADDRESS) : BOOLEAN; 195 | VAR tag, offset : ADDRESS; 196 | BEGIN 197 | S.GET(p-SZA, tag); 198 | S.GET(p+SZA, offset); 199 | RETURN (tag = p) & (offset = NoPtrSntl) 200 | END IsFreeBlock; 201 | 202 | PROCEDURE CheckAddress*(p : ADDRESS); 203 | BEGIN 204 | IF ~WithinHeap(p) THEN 205 | Error("Address is outside Heap", p); 206 | END; 207 | IF IsFreeBlock(p) THEN 208 | Error("Pointer object is free", p); 209 | END; 210 | END CheckAddress; 211 | 212 | (* Check that a pointer is NIL or within the heap *) 213 | 214 | PROCEDURE CheckPointer*(ptr : S.PTR); 215 | BEGIN 216 | IF ptr = NIL THEN RETURN END; 217 | CheckAddress(S.VAL(ADDRESS, ptr)); 218 | END CheckPointer; 219 | 220 | (* Get the offset within heap object of the pointer number *) 221 | 222 | PROCEDURE GetPointerOffset*(ptr : S.PTR; idx : LONGINT) : ADDRESS; 223 | VAR 224 | tag, op : ADDRESS; 225 | BEGIN 226 | S.GET(S.VAL(ADDRESS, ptr) - SZA, tag); 227 | S.GET(tag + SZA + idx * SZA, op); 228 | RETURN op; 229 | END GetPointerOffset; 230 | 231 | PROCEDURE Set*(setVerbose, setTrap : BOOLEAN); 232 | BEGIN 233 | verbose := setVerbose; 234 | trap := setTrap; 235 | END Set; 236 | 237 | BEGIN 238 | Set(FALSE, TRUE); 239 | END HeapDebug. 240 | -------------------------------------------------------------------------------- /test/HeapGrind.ob2: -------------------------------------------------------------------------------- 1 | MODULE HeapGrind; 2 | 3 | (* 4 | When compiled with optimisation (-O2, or -O3) this program segfaults when a 5 | live heap object is incorrectly freed by the GC. 6 | 7 | Ofront+ -88 -s -e -2 -m HeapGrind.ob2 8 | gcc -g -O3 -I$OFRONT/Mod/Lib -I$OFRONT/Target/$OTARGET/Lib/Obj -L$OFRONT/Target/$OTARGET/Lib HeapGrind.c -o HeapGrind -lOfront 9 | 10 | ./HeapGrind 11 | Iteration: 0 12 | 8191 nodes created 13 | 14 | ERROR: Pointer object is free 0000000107D9C020 15 | Segmentation fault: 11 16 | *) 17 | 18 | 19 | IMPORT 20 | Kernel, 21 | Console, 22 | HeapDebug, 23 | S := SYSTEM; 24 | 25 | TYPE 26 | ADDRESS = S.ADRINT; 27 | 28 | CONST 29 | SZA = SIZE(ADDRESS); 30 | NoPtrSntl = S.VAL(ADDRESS, -SZA); 31 | 32 | TYPE 33 | Node = POINTER TO RECORD 34 | id : LONGINT; 35 | left, right : Node; 36 | END; 37 | 38 | List = POINTER TO RECORD 39 | next : List; 40 | p0 : List; 41 | id : LONGINT; 42 | END; 43 | 44 | (* Determine if memory block is free *) 45 | 46 | PROCEDURE IsFreeBlock*(p : ADDRESS) : BOOLEAN; 47 | VAR tag, offset : ADDRESS; 48 | BEGIN 49 | S.GET(p-SZA, tag); 50 | S.GET(p+SZA, offset); 51 | RETURN (tag = p) & (offset = NoPtrSntl) 52 | END IsFreeBlock; 53 | 54 | PROCEDURE CheckAddress*(p : ADDRESS); 55 | BEGIN 56 | IF IsFreeBlock(p) THEN 57 | Console.Ln; Console.String("ERROR: Pointer object is free "); Console.LongHex(p); Console.Ln; 58 | END; 59 | END CheckAddress; 60 | 61 | (* Check that a pointer is NIL or within the heap *) 62 | 63 | PROCEDURE CheckPointer*(ptr : S.PTR); 64 | BEGIN 65 | IF ptr = NIL THEN RETURN END; 66 | CheckAddress(S.VAL(ADDRESS, ptr)); 67 | END CheckPointer; 68 | 69 | (* append ID to a list of LONGINTs *) 70 | 71 | PROCEDURE Append(VAR list : List; id : LONGINT); 72 | VAR element : List; 73 | BEGIN 74 | NEW(element); 75 | element.id := id; 76 | element.next := list; 77 | list := element; 78 | END Append; 79 | 80 | (* Create a binary tree of given depth, assign a different id to each node. *) 81 | 82 | PROCEDURE Tree(depth : LONGINT; VAR count : LONGINT) : Node; 83 | VAR 84 | node : Node; 85 | BEGIN 86 | NEW(node); 87 | node.id := count; INC(count); 88 | IF depth = 0 THEN 89 | node.left := NIL; 90 | node.right := NIL; 91 | ELSE 92 | node.left := Tree(depth-1, count); 93 | node.right := Tree(depth-1, count); 94 | END; 95 | RETURN node; 96 | END Tree; 97 | 98 | (* Visit each node of a tree, returning a list of the LONGINT ids. *) 99 | 100 | PROCEDURE Visit(node : Node; VAR list : List); 101 | BEGIN 102 | IF node = NIL THEN RETURN END; 103 | Append(list, node.id); 104 | Visit(node.left, list); 105 | Visit(node.right, list); 106 | END Visit; 107 | 108 | PROCEDURE Test(depth, reps : LONGINT); 109 | VAR 110 | tree : Node; 111 | list : List; 112 | i, j, count : LONGINT; 113 | BEGIN 114 | Console.String("ADR(list):"); Console.LongHex(S.ADR(list)); Console.Ln; 115 | FOR i := 0 TO reps-1 DO 116 | Console.String("Iteration: "); Console.Int(i, 0); Console.Ln; 117 | 118 | (* build a binary tree *) 119 | count := 0; 120 | tree := Tree(depth, count); 121 | Console.Int(count, 0); Console.String(" nodes created"); Console.Ln; 122 | 123 | FOR j := 1 TO 10 DO 124 | list := NIL; 125 | Visit(tree, list); 126 | count := 0; 127 | WHILE list # NIL DO 128 | HeapDebug.CheckPointer(list); (* Note: list points to free block *) 129 | list := list.next; (* <-- SEGFAULT here *) 130 | INC(count); 131 | END; 132 | Console.Int(count, 0); Console.String(" nodes visited"); Console.Ln; 133 | END; 134 | END; 135 | END Test; 136 | 137 | BEGIN 138 | HeapDebug.Set(TRUE, TRUE); 139 | Test(12, 100); 140 | Console.String("Success!"); Console.Ln; 141 | END HeapGrind. 142 | -------------------------------------------------------------------------------- /test/TestAll.ob2: -------------------------------------------------------------------------------- 1 | MODULE TestAll; 2 | 3 | IMPORT 4 | T := Tests, 5 | TestStrings, 6 | TestPath, 7 | TestValue, 8 | TestJSON; 9 | 10 | BEGIN 11 | T.Done; 12 | END TestAll. 13 | -------------------------------------------------------------------------------- /test/TestDir.ob2: -------------------------------------------------------------------------------- 1 | MODULE TestDir; 2 | 3 | IMPORT 4 | Kernel, 5 | Out := arOut, 6 | arDir; 7 | 8 | PROCEDURE Test(path-: ARRAY OF CHAR); 9 | VAR 10 | f : arDir.FileFinder; 11 | name : ARRAY 256 OF CHAR; 12 | BEGIN 13 | IF f.Open(path) THEN 14 | WHILE f.Next(name) DO 15 | Out.String(name); Out.Ln; 16 | END; 17 | f.Close; 18 | ELSE 19 | Out.String("Open failed for "); Out.String(path); Out.Ln; 20 | END; 21 | END Test; 22 | 23 | BEGIN 24 | Test("."); 25 | END TestDir. 26 | -------------------------------------------------------------------------------- /test/TestJSON.Mod: -------------------------------------------------------------------------------- 1 | MODULE TestJSON; 2 | 3 | IMPORT 4 | T := Tests, 5 | TV := TestValue, 6 | Out := arOut, 7 | F := arFormat, 8 | V := arValue, 9 | J := arJSON; 10 | 11 | (* compare JSON representation of with *) 12 | 13 | PROCEDURE Equals(o : V.Object; text : ARRAY OF CHAR); 14 | VAR s : V.String; 15 | BEGIN 16 | s := o.ToJSON(); 17 | T.String(s.value^, text); 18 | END Equals; 19 | 20 | PROCEDURE Test; 21 | CONST 22 | json1 = '{"one":1,"two":2,"debug":false,"pi":3.14159,"list":[0,1,2,3]}'; 23 | VAR 24 | r : V.Record; 25 | BEGIN 26 | Equals(V.int(22),'22'); 27 | Equals(V.real(1.2), '1.2'); 28 | Equals(V.str("a string"), '"a string"'); 29 | Equals(TV.Range(0, 9), '[0,1,2,3,4,5,6,7,8,9]'); 30 | Equals(TV.Tree(4), '[[[[0,1],[2,3]],[[4,5],[6,7]]],[[[8,9],[10,11]],[[12,13],[14,15]]]]'); 31 | 32 | r := V.record(); 33 | r.Set("one", V.int(1)); 34 | r.Set("two", V.int(2)); 35 | r.Set("debug", V.bool(FALSE)); 36 | r.Set("pi", V.real(3.14159265)); 37 | r.Set("list", TV.Range(0,3)); 38 | 39 | Equals(r, json1); 40 | Equals(J.ParseString(json1), json1); 41 | END Test; 42 | 43 | BEGIN 44 | T.Begin("TestJSON"); 45 | Test; 46 | T.End; 47 | END TestJSON. 48 | -------------------------------------------------------------------------------- /test/TestPath.ob2: -------------------------------------------------------------------------------- 1 | MODULE TestPath; 2 | 3 | IMPORT 4 | T := Tests, 5 | Path := arPath; 6 | 7 | BEGIN 8 | T.Begin("TestPath"); 9 | 10 | T.StringF(Path.DirName, "/a/b/c/file.ext", "/a/b/c"); 11 | T.StringF(Path.BaseName, "/a/b/c/file.ext", "file.ext"); 12 | T.StringF(Path.ExtName, "/a/b/c/file.ext", ".ext"); 13 | 14 | T.StringF(Path.DirName, "file.ext", ""); 15 | T.StringF(Path.BaseName, "/a/b/c/", ""); 16 | T.StringF(Path.ExtName, "file", ""); 17 | T.StringF(Path.ExtName, "file.ext/", ""); 18 | 19 | T.StringF(Path.DirName, "", ""); 20 | T.StringF(Path.BaseName, "", ""); 21 | T.StringF(Path.ExtName, "", ""); 22 | 23 | T.End; 24 | END TestPath. 25 | -------------------------------------------------------------------------------- /test/TestStrings.ob2: -------------------------------------------------------------------------------- 1 | MODULE TestStrings; 2 | 3 | IMPORT 4 | T := Tests, 5 | S := arStrings; 6 | 7 | VAR 8 | buffer : ARRAY 128 OF CHAR; 9 | ptr : S.StringPtr; 10 | 11 | BEGIN 12 | T.Begin("TestStrings"); 13 | 14 | (* Strings.Length *) 15 | T.Int(S.Length("three"), 5); 16 | T.Int(S.Length(""), 0); 17 | 18 | (* Strings.Equal *) 19 | T.Assert(S.Equal("one", "one")); 20 | T.Assert(S.Equal("", "")); 21 | T.Assert(~S.Equal("on", "one")); 22 | T.Assert(~S.Equal("one", "on")); 23 | 24 | (* Strings.Assign / Strings.Append *) 25 | S.Assign("", buffer); 26 | T.String(buffer, ""); 27 | 28 | S.Assign("one", buffer); 29 | T.String(buffer, "one"); 30 | 31 | S.Append("", buffer); 32 | T.String(buffer, "one"); 33 | 34 | S.Append("two", buffer); 35 | T.String(buffer, "onetwo"); 36 | 37 | (* Strings.Extract *) 38 | S.Extract("one,two,three", 4, 3, buffer); 39 | T.String(buffer, "two"); 40 | 41 | S.Extract("one,two,three", 4, 100, buffer); 42 | T.String(buffer, "two,three"); 43 | 44 | S.Extract("one,two,three", 4, 0, buffer); 45 | T.String(buffer, ""); 46 | 47 | (* Strings.StartsWith *) 48 | T.Assert(S.StartsWith("test.Mod", "test")); 49 | T.Assert(~S.StartsWith("test.Mod", "tess")); 50 | T.Assert(S.StartsWith("test.Mod", "")); 51 | 52 | (* Strings.EndsWith *) 53 | T.Assert(S.EndsWith("test.Mod", ".Mod")); 54 | T.Assert(~S.EndsWith("test.Mod", ".Mo")); 55 | T.Assert(S.EndsWith("test.Mod", "")); 56 | 57 | T.Int(S.IndexOf("one.two.three", "#", 0), -1); 58 | T.Int(S.IndexOf("one.two.three", ".", 0), 3); 59 | T.Int(S.IndexOf("one.two.three", ".", 3), 3); 60 | T.Int(S.IndexOf("one.two.three", ".", 4), 7); 61 | 62 | T.Int(S.LastIndexOf("one.two.three", "#", 0), -1); 63 | T.Int(S.LastIndexOf("one.two.three", ".", 0), -1); 64 | T.Int(S.LastIndexOf("one.two.three", ".", 12), 7); 65 | T.Int(S.LastIndexOf("one.two.three", ".", -1), 7); 66 | T.Int(S.LastIndexOf("one.two.three", ".", 7), 7); 67 | T.Int(S.LastIndexOf("one.two.three", ".", 6), 3); 68 | 69 | ptr := S.Copy("a string"); 70 | T.String(ptr^, "a string"); 71 | 72 | T.End; 73 | END TestStrings. 74 | -------------------------------------------------------------------------------- /test/TestValue.ob2: -------------------------------------------------------------------------------- 1 | MODULE TestValue; 2 | 3 | IMPORT 4 | T := Tests, 5 | F := arFormat, 6 | V := arValue, 7 | Out := arOut; 8 | 9 | (* compare string representation of with *) 10 | 11 | PROCEDURE Equals(o : V.Object; text : ARRAY OF CHAR); 12 | VAR s : V.String; 13 | BEGIN 14 | s := o.ToString(); 15 | T.String(s.value^, text); 16 | END Equals; 17 | 18 | (* return a binary tree *) 19 | PROCEDURE Tree*(levels : INTEGER) : V.Object; 20 | VAR 21 | id : INTEGER; 22 | 23 | PROCEDURE Inner(levels : INTEGER) : V.Object; 24 | VAR 25 | result : V.Integer; 26 | BEGIN 27 | IF levels = 0 THEN 28 | result := V.int(id); INC(id); 29 | RETURN result; 30 | END; 31 | RETURN V.array2(Inner(levels-1), Inner(levels-1)); 32 | END Inner; 33 | 34 | BEGIN 35 | id := 0; 36 | RETURN Inner(levels); 37 | END Tree; 38 | 39 | (* return a list of integers *) 40 | PROCEDURE Range*(from, to : INTEGER) : V.List; 41 | VAR l : V.List; 42 | BEGIN 43 | l := V.list(); 44 | WHILE from <= to DO 45 | l.Append(V.int(from)); INC(from); 46 | END; 47 | RETURN l 48 | END Range; 49 | 50 | PROCEDURE TestObject; 51 | VAR 52 | l : V.List; 53 | o : V.Object; 54 | r : V.Record; 55 | shallowCopy, deepCopy : V.Object; 56 | BEGIN 57 | T.Section("Objects"); 58 | 59 | l := V.list(); 60 | l.Append(V.str("string")); 61 | l.Append(V.int(0)); 62 | l.Append(V.real(1.5)); 63 | l.Append(V.bool(TRUE)); 64 | l.Append(V.set({1,3,5,7,9,MAX(SET)})); 65 | l.Append(Range(0,3)); 66 | 67 | r := V.record(); 68 | r.Set("x", V.int(5)); 69 | r.Set("y", V.int(6)); 70 | l.Append(r); 71 | 72 | (* copies structure *) 73 | T.Assert(V.Equals(l, V.Copy(l))); 74 | T.Assert(V.Equals(l, V.DeepCopy(l))); 75 | 76 | (* shallow/deep copy *) 77 | l := V.list(); 78 | l.Append(V.int(0)); 79 | r := V.record(); 80 | r.Set("l", l); 81 | Equals(r, "{l:[0]}"); 82 | 83 | shallowCopy := V.Copy(r); 84 | deepCopy := V.DeepCopy(r); 85 | l.Set(0, V.int(1)); 86 | 87 | (* shallow copy should be equal, deep copy different *) 88 | T.Assert(V.Equals(r, shallowCopy)); 89 | T.Assert(~V.Equals(r, deepCopy)); 90 | END TestObject; 91 | 92 | PROCEDURE TestList; 93 | VAR 94 | a, b : V.List; 95 | BEGIN 96 | T.Section("Lists"); 97 | 98 | a := Range(0, 9); 99 | T.Int(a.length, 10); 100 | T.Assert(V.Equals(a, Range(0, 9))); 101 | Equals(a, "[0,1,2,3,4,5,6,7,8,9]"); 102 | 103 | (* Get/Set *) 104 | T.Assert(V.Equals(a.Get(2), V.int(2))); 105 | a.Set(2, V.int(20)); 106 | T.Assert(V.Equals(a.Get(2), V.int(20))); 107 | 108 | (* IndexOf *) 109 | T.Int(a.IndexOf(V.int(5)), 5); 110 | T.Int(a.IndexOf(V.int(0)), 0); 111 | T.Int(a.IndexOf(V.int(9)), 9); 112 | T.Int(a.IndexOf(V.str("Hello")), -1); 113 | 114 | (* Append/Prepend *) 115 | a := V.list(); 116 | a.Append(V.str("one")); 117 | Equals(a, '["one"]'); 118 | 119 | a.Append(V.str("two")); 120 | Equals(a, '["one","two"]'); 121 | 122 | a.Prepend(V.str("zero")); 123 | Equals(a, '["zero","one","two"]'); 124 | 125 | T.Int(a.IndexOf(V.str("one")), 1); 126 | T.Int(a.IndexOf(V.str("four")), -1); 127 | 128 | (* Concat/Extend *) 129 | a := Range(0,3); 130 | b := Range(4,6); 131 | Equals(a.Concat(b), "[0,1,2,3,4,5,6]"); 132 | 133 | a := Range(0,3); 134 | a.Extend(b); 135 | Equals(a, "[0,1,2,3,4,5,6]"); 136 | 137 | a := V.list(); 138 | a.Append(Range(0,3)); 139 | a.Append(Range(4,6)); 140 | Equals(a, "[[0,1,2,3],[4,5,6]]"); 141 | END TestList; 142 | 143 | PROCEDURE TestString; 144 | VAR 145 | a, b, c : V.String; 146 | BEGIN 147 | T.Section("Strings"); 148 | 149 | a := V.str("test string"); 150 | T.String(a.value^, "test string"); 151 | T.Int(a.length, 11); 152 | 153 | T.Int(a.Compare("test string"), 0); 154 | T.Int(a.Compare("string"), 1); 155 | T.Int(a.Compare("yes"), -1); 156 | 157 | T.Assert(a.EndsWith("string")); 158 | T.Assert(a.EndsWith("")); 159 | T.Assert(~a.EndsWith("thing")); 160 | T.Assert(~a.EndsWith("strinq")); 161 | 162 | T.Assert(a.StartsWith("test")); 163 | T.Assert(a.StartsWith("")); 164 | T.Assert(~a.StartsWith("tesx")); 165 | 166 | a := V.str("abc"); 167 | b := V.str("def"); 168 | T.Assert(a.Equals(a)); 169 | T.Assert(~a.Equals(b)); 170 | 171 | c := a.Concat(b); 172 | Equals(c, "abcdef"); 173 | 174 | Equals(c.Extract(2,2), "cd"); 175 | Equals(c.Extract(-3, 4), "def"); 176 | Equals(c.Extract(1, 0), ""); 177 | 178 | Equals(V.Split(",,,", ","), '["","","",""]'); 179 | Equals(V.Split("one,two,three,four", ","), '["one","two","three","four"]'); 180 | Equals(V.Split("one", ","), '["one"]'); 181 | 182 | END TestString; 183 | 184 | BEGIN 185 | T.Begin("TestValue"); 186 | 187 | TestString; 188 | TestList; 189 | TestObject; 190 | 191 | T.End; 192 | END TestValue. 193 | -------------------------------------------------------------------------------- /test/Tests.ob2: -------------------------------------------------------------------------------- 1 | MODULE Tests; 2 | 3 | IMPORT 4 | Kernel, 5 | Out := arOut, 6 | Strings := arStrings; 7 | 8 | TYPE 9 | StringFunc* = PROCEDURE (path-: Strings.String; VAR result : Strings.String); 10 | 11 | VAR 12 | tests, errors : LONGINT; 13 | inSection : BOOLEAN; 14 | section : ARRAY 128 OF CHAR; 15 | sectionStart : LONGINT; 16 | 17 | PROCEDURE Init; 18 | BEGIN 19 | Strings.Assign("", section); 20 | tests := 0; 21 | errors := 0; 22 | inSection := FALSE; 23 | END Init; 24 | 25 | PROCEDURE Begin*(name : ARRAY OF CHAR); 26 | BEGIN 27 | Out.String(name); Out.Char(":"); Out.Ln; 28 | Init; 29 | END Begin; 30 | 31 | PROCEDURE End*; 32 | BEGIN 33 | Out.String("- Completed "); Out.Int(tests); 34 | Out.String(" tests with "); Out.Int(errors); 35 | Out.String(" errors"); Out.Ln; 36 | END End; 37 | 38 | PROCEDURE Section*(name : ARRAY OF CHAR); 39 | BEGIN 40 | inSection := TRUE; 41 | Strings.Assign(name, section); 42 | sectionStart := tests; 43 | END Section; 44 | 45 | PROCEDURE Error*; 46 | BEGIN 47 | INC(errors); 48 | IF inSection THEN 49 | Out.String(" "); 50 | Out.String(section); 51 | Out.String(" #"); Out.Int(tests-sectionStart); 52 | ELSE 53 | Out.String(" Test #"); Out.Int(tests); 54 | END; 55 | Out.Char(" "); 56 | END Error; 57 | 58 | PROCEDURE Assert*(value : BOOLEAN); 59 | BEGIN 60 | INC(tests); 61 | IF ~value THEN 62 | Error; 63 | Out.String("Returned:FALSE"); Out.Ln; 64 | END; 65 | END Assert; 66 | 67 | PROCEDURE Int*(value, expected : LONGINT); 68 | BEGIN 69 | INC(tests); 70 | IF value # expected THEN 71 | Error; 72 | Out.String("Expected:"); Out.Int(expected); 73 | Out.String(", Returned:"); Out.Int(value); Out.Ln; 74 | END; 75 | END Int; 76 | 77 | PROCEDURE String*(value-, expected- : Strings.String); 78 | BEGIN 79 | INC(tests); 80 | IF ~Strings.Equal(value, expected) THEN 81 | Error; 82 | Out.String("Expected:"); Out.String(expected); 83 | Out.String(", Returned:"); Out.String(value); Out.Ln; 84 | END; 85 | END String; 86 | 87 | PROCEDURE StringF*(func : StringFunc; value-, expected-: Strings.String); 88 | VAR buffer : ARRAY 1024 OF CHAR; 89 | BEGIN 90 | func(value, buffer); 91 | String(buffer, expected); 92 | END StringF; 93 | 94 | PROCEDURE Done*; 95 | BEGIN 96 | Kernel.Exit(errors); 97 | END Done; 98 | 99 | BEGIN 100 | Init; 101 | END Tests. 102 | --------------------------------------------------------------------------------