Compare commits

...

148 commits

Author SHA1 Message Date
Norayr Chilingarian
65baeb77a9
Merge pull request #113 from robdaemon/fix-gcc-15
Fixes build problems on gcc 15
2026-02-04 12:51:31 +04:00
Robert Roland
9fce469f23 Fixes build problems on gcc 15
GCC 15 changes the C language standard to gnu23, and VOC compiles just fine on gnu11.

Tested against GCC 15 and GCC 14.
2026-02-03 17:43:38 -08:00
Norayr Chilingarian
84516b2ac6 prevents orphaned or misplaced comments from being written to symbol
files.
2025-07-19 05:56:37 +04:00
Norayr Chilingarian
a517a42357 comments length increased, multiline comments are also now possible. 2025-07-19 05:48:27 +04:00
Norayr Chilingarian
50b5a1438e better handling of faulty symbol files. ethStrings comments fixed. 2025-07-19 05:13:09 +04:00
Norayr Chilingarian
fa9e73f7af adapted Base64 file from Oberon S3. 2025-07-10 23:08:59 +04:00
Norayr Chilingarian
a9465ccfc6 bootstrap sources. 2025-06-24 18:27:35 +04:00
Norayr Chilingarian
dac6504f12 comments in symbol files, viewable by showdef browser. 2025-06-24 17:44:19 +04:00
Norayr Chilingarian
2f1ce08aff should fix type-bound procedure name mismatch between calls and definitions 2025-06-14 17:12:48 +04:00
Carlos Une
28c327be28 Math, MathL: add procedure fcmp 2025-05-08 15:48:46 +04:00
Norayr Chilingarian
94683df1d8
Merge pull request #111 from InnaKhachikyan/master
modified Index checking to handle run-time variable index containing …
2025-04-23 02:46:44 +04:00
Inna Khachikyan
f0e92c7434 modified Index checking to handle run-time variable index containing negative value 2025-04-17 23:44:56 +04:00
Norayr Chilingarian
71488ffe85
Merge pull request #110 from rbmk-plus/master
add ctags, fix dead links, and other minor fixes
2025-04-04 18:13:57 +00:00
sevoves
378de43274 rewording doc/ctags.md 2025-04-04 22:00:31 +04:00
sevoves
1fbbb68dc7 rewording ctags doc 2025-04-04 21:56:16 +04:00
sevoves
9846292b85 minor changes in docs 2025-04-04 21:51:30 +04:00
sevoves
bb7a731197 small change in ctags.md 2025-04-04 21:44:46 +04:00
sevoves
7dafb02d1e add ctags doc 2025-04-04 21:40:59 +04:00
sevoves
5e52f8c231 add ctags doc and remove comments from oberon.ctags 2025-04-04 21:39:45 +04:00
sevoves
e298d10d99 rewording in configure.c 2025-04-04 15:43:44 +04:00
sevoves
3460b9f78a create macros for ignoring flood warnings 2025-04-04 15:37:41 +04:00
sevoves
089ca94207 remove scope pop in ctag since file is the scope 2025-04-04 00:38:41 +04:00
sevoves
b12029e3ed remove warning floods for MinGW compiler 2025-04-03 22:26:20 +04:00
sevoves
cd06cd32b1 ignore common warnings in gcc and clang 2025-04-03 22:09:20 +04:00
sevoves
7691293a5b replace egrep with grep -E for less warnings 2025-04-03 21:05:42 +04:00
sevoves
d005317424 address more caveats in oberon.ctags 2025-04-03 20:57:00 +04:00
sevoves
a25b44ae21 exclude all confidence test files without extension except expect 2025-04-03 20:38:12 +04:00
sevoves
e64d4c4d44 add test binaries to .gitignore 2025-04-03 20:14:24 +04:00
sevoves
ac82959092 add stuff to .gitignore 2025-04-03 20:05:37 +04:00
sevoves
cb098d448d update deaed links in ReadMe 2025-04-03 19:20:01 +04:00
sevoves
9e9bbe7581 fix empty link in ReadMe 2025-04-03 19:00:09 +04:00
sevoves
9084ca288b rewording ceveats on oberon.ctags 2025-04-03 16:29:13 +04:00
sevoves
233761e7fa more matches 2025-04-03 08:16:27 +04:00
sevoves
e936f7d7b0 fix typo in ReadMe 2025-04-03 07:52:59 +04:00
sevoves
c4f3792047 add ctags 2025-04-03 07:52:22 +04:00
Norayr Chilingarian
812b3a56d6
Merge pull request #106 from tkurtbond/openbsdinstallfailsldconfig
Don't try to uninstall the shared libraries unless the directory exists.
2025-03-13 16:19:38 +04:00
Norayr Chilingarian
764e018de2
Merge pull request #108 from pascalecu/feat/netbsd
feat: add netbsd support (#107)
2025-03-13 16:17:37 +04:00
Ștefan-Iulian Alecu
b22fc3fd3f
feat: add netbsd support in configure.c 2025-03-12 02:07:15 +02:00
Norayr Chilingarian
2178fa7b18 now test server can listen on any ipv4 address. 2025-02-21 04:52:54 +04:00
Norayr Chilingarian
e36e862c8c Revert "now test server can listen on any ipv4 address."
This reverts commit afe5a2d824.
2025-02-21 04:52:20 +04:00
Norayr Chilingarian
afe5a2d824 now test server can listen on any ipv4 address. 2025-02-21 04:48:39 +04:00
T. Kurt Bond
7d14452a51 Don't try to uninstall the shared libraries unless the directory exists.
Otherwise it fails on OpenBSD during the first installation with:

    ldconfig: /usr/local/sw/versions/voc/git/lib: No such file or directory
2025-01-17 08:10:47 -05:00
Norayr Chilingarian
8d2d479664 unix nil check won't prevent windows builds. 2024-08-23 13:51:15 +04:00
9292b2a7d5
Merge pull request #102 from antranigv/master
set language to Oberon
2024-05-11 21:44:48 +04:00
Antranig Vartanian
e189882af8
set language to Oberon 2024-05-11 21:43:22 +04:00
Norayr Chilingarian
48741af5ac
Merge pull request #101 from vishaps/catching_segfault
now "NIL access" error in Modules.Mod indeed works.
2024-04-13 05:13:38 +04:00
Norayr Chilingarian
7fb61a066b now "NIL access" error in Modules.Mod indeed works. 2024-04-13 04:14:18 +04:00
Norayr Chilingarian
7ea99e20a0 fixed crash introduced in commit aed9134e99
see comments in OPB.Mod
2024-04-12 21:52:25 +04:00
Norayr Chilingarian
a7fe55d434 changed hardcoded test file name to the one which exists in current
directory.
2024-03-21 19:36:43 +04:00
Norayr Chilingarian
85dff7734d wrapper function for compatibility with project oberon 13 sources. 2024-03-14 18:01:26 +04:00
Norayr Chilingarian
e376e59f58 md5sum test will now work with binary files as well. 2024-02-21 03:30:49 +04:00
Norayr Chilingarian
75c155f8ec md5 sum calculation example. 2024-01-26 02:20:24 +04:00
Norayr Chilingarian
dfaf2d3622 example on how to read commandline arguments with Texts. 2024-01-14 17:15:40 +04:00
Norayr Chilingarian
5a93546143 insignificant readme and makefile changes. 2023-12-13 15:56:49 +04:00
Norayr Chilingarian
ff42920226 gcc: warning: switch ‘-gstabs’ is no longer supported - removed it. 2023-10-05 17:03:30 +04:00
Norayr Chilingarian
c4213e333a small fix to build options, whitespace is necessary. 2023-10-05 17:00:23 +04:00
Norayr Chilingarian
b8d08c007a additional opts should be on the left of other CFLAGS,
this fixes linking to third party libraries issue on some operating systems
including Ubuntu and Debian, probably older gcc 11 is to blame.
Did not notice this problem on Gentoo, at least with gcc 13.
2023-10-05 16:54:37 +04:00
Norayr Chilingarian
bd35c73c1f more changes for tcc 2023-04-26 04:01:15 +04:00
Faraz Vahedi
7ca08f1ef1
Remove an unused import 2022-07-04 16:31:45 +00:00
Norayr Chilingarian
9e3995d0ee added Reset() function to VT100 module. 2022-05-26 01:29:02 +04:00
Norayr Chilingarian
590398b27e update of bootstrap files. 2022-03-15 17:23:17 +04:00
Norayr Chilingarian
32ec67552f fix in ooc Strings modules to prevent index out of range error. 2022-03-15 17:20:41 +04:00
Norayr Chilingarian
bc8adf76c1 fixes "memory past end of source var" warning, solution by @kekcleader;
issue: https://github.com/vishaps/voc/issues/96
2021-12-27 19:52:27 +04:00
Norayr Chilingarian
3d62284b32 typo fix: oname should be ONAME
https://github.com/vishaps/voc/issues/97
2021-12-27 19:38:05 +04:00
dcwbrown
8bd5388ffb Merge branch 'master' of https://github.com/vishaps/voc 2020-06-16 18:23:27 +01:00
David C W Brown
c9b56ea10e Remove GC blocking IF test, add abstract comment to each compiler mod. 2020-06-16 18:12:30 +01:00
Norayr Chilingarian
cfa8aa2c39
Merge pull request #85 from vishaps/ooc_c_sizes
fixed ooc.C typesizes and made X11 examples compile.
2020-04-02 23:32:15 +04:00
Norayr Chilingarian
ff87e23780 fixed ooc.C typesizes and made X11 examples compile. 2020-03-29 20:40:36 +04:00
Dave Brown
63008f6d30 Fix -OC set size in usage text 2019-11-19 19:45:23 +00:00
Dave Brown
7f4b284aef Correct set size in component pascal compatability mode 2019-11-19 15:53:20 +00:00
Dave Brown
2ddbf5d517 Correct Args.argc to INTEGER rather than LONGINT 2019-11-09 11:32:03 +00:00
Norayr Chilingarian
6ae2f96d08 Undecl var fix (#74)
* fix like 78036911d2

* OPT.DynArr to be precise

* removed PromoteIntConstToLInt() function call

* update of bootstrap sources.
2019-11-07 16:20:08 +00:00
David C W Brown
760e14bbe1
Still trying to get build status to refresh. 2019-11-04 19:30:42 +00:00
David C W Brown
1d48dd8114
Trying harder to get build status to refresh, part 2. 2019-11-04 19:29:12 +00:00
David C W Brown
84b6f0aa92
Trying harder to get build status to refresh, part 1. 2019-11-04 19:28:52 +00:00
David C W Brown
0b136c44e9
No real change - attempting to clear the github cache of build status svg. 2019-11-04 19:22:49 +00:00
David C W Brown
93b6ecc234
Use https to get build status. 2019-11-04 18:24:47 +00:00
David C W Brown
b2f7087966
Reflect distinction between build (make full) and install (make install) 2019-11-04 18:23:17 +00:00
David Brown
e4743120de Add support for building in a path containing spaces. 2019-11-04 16:06:16 +00:00
David C W Brown
8cec6b3794
A bit more info about static vs dynamic linking
Some systems support only one.
2019-10-11 17:41:45 +01:00
David Brown
49cb239730 Update autobuild scripts for freenas server 2019-10-11 17:24:05 +01:00
Norayr Chilingarian
7b9b5cb4f1 simpler way of removing 'static' for tcc in configure.c, reverted oberon.mk back, according to this comment: a35668bf93 (r35448231) update of bootstrap sources. 2019-10-11 15:00:02 +04:00
Norayr Chilingarian
9626a95daa updated bootstrap files, main change should be in ext-tools.c (linking
options, whitespace removed)
2019-10-10 17:46:12 +04:00
Norayr Chilingarian
a35668bf93 initial tcc/linux changes 2019-10-10 17:41:18 +04:00
David Brown
e3a07e77fa Trigger again 2019-01-07 19:17:34 +00:00
David Brown
e07c125017 Trigger again 2019-01-07 18:58:35 +00:00
David Brown
d40b590306 Merge branch 'master' of https://github.com/vishaps/voc 2019-01-07 18:47:40 +00:00
David Brown
5e903cb3d9 Trigger build 2019-01-07 18:47:15 +00:00
David C W Brown
2e93bc0909
Correct the other reference to the windows installation doc. 2019-01-07 18:10:33 +00:00
David Brown
6842928bf8 Integrate rangechecked casting correction from @svorkoetter. 2019-01-04 18:54:55 +00:00
Norayr Chilingarian
8890fe1336 windows installation document link fixed. 2018-11-24 00:28:13 +04:00
David Brown
af38056518 Add ruminations on how Oberon Files.Mod behaviour differs from conventional systems. 2018-04-27 13:58:10 +01:00
David Brown
b1b4d6b602 Update bootstrap C source files. 2018-04-24 18:53:02 +01:00
David Brown
ee01f97392 Expose file name and path max lengths in Files.Mod. 2018-04-24 18:51:39 +01:00
David Brown
f7904230c9 Update bootstrap C source files. 2018-04-24 17:46:55 +01:00
David Brown
70f2839c76 Add 'Filename too long' error in Files.Mod. 2018-04-24 17:32:38 +01:00
David Brown
1c8828ede1 Update bootstrap C source files. 2018-04-24 16:11:16 +01:00
David Brown
f458b98ff2 Enable index checks in Files.Mod and OPS.Mod. 2018-04-24 16:04:56 +01:00
David Brown
66f0363474 Fix missing quotes in path setting for tests, allowing them to run in linux under windows. 2018-04-24 12:21:57 +01:00
David C W Brown
3c66e07ff0 Merge branch 'master' of https://github.com/vishaps/voc 2018-04-23 20:45:28 +01:00
David C W Brown
afe570e096 Restore temporarily commented git clone in autobuild runbuilds.pl 2018-04-23 20:45:01 +01:00
David C W Brown
8a0b3d5b4c Merge branch 'master' of https://github.com/vishaps/voc 2018-04-23 20:22:23 +01:00
David C W Brown
9928bfe70d Fix build order of Reals.Mod in Microsoft C builds. 2018-04-23 20:21:50 +01:00
David C W Brown
5ec7c2359b Merge branch 'master' of https://github.com/vishaps/voc 2018-04-23 18:25:19 +01:00
David C W Brown
175eafb900 New autobuild system 2018-04-23 18:24:41 +01:00
David C W Brown
2de6345b99
Update ReadMe.md 2018-04-23 17:29:05 +01:00
David C W Brown
2d8cd4a478
Update ReadMe.md 2018-04-23 17:28:43 +01:00
David C W Brown
02ea27e8b5
Update ReadMe.md 2018-04-22 20:21:09 +01:00
David C W Brown
ffad2a1a14
Update ReadMe.md 2018-04-22 20:13:09 +01:00
David C W Brown
a2f3f72795
Update ReadMe.md 2018-04-22 20:11:17 +01:00
David C W Brown
56ea3f3a27
Update ReadMe.md 2018-04-22 19:55:37 +01:00
David C W Brown
1bd4070e06
Update ReadMe.md 2018-04-22 18:23:44 +01:00
David C W Brown
1da977da55
Update ReadMe.md 2018-04-22 18:21:10 +01:00
norayr
419e90e073 in order to instigate new build and update the build status png synced
beep.Mod with actual library sources.
2018-04-14 23:09:26 +04:00
Norayr Chilingarian
4bbacbaaa4 brought sources in sync with current library state. 2018-04-10 23:29:14 +04:00
Norayr Chilingarian
c43644ffeb bootstrap sources update. 2018-04-10 22:51:26 +04:00
Norayr Chilingarian
9470716304 issue #64 https://github.com/vishaps/voc/issues/64 2018-04-10 22:48:37 +04:00
David Brown
1bd70f367e Correct size_t definition for OpenBSD .gt. 6.2 thanks to @ibara 2017-09-06 13:07:00 +01:00
norayr
2ec7f3277a applied changes for the issue #61, with the @jtempl fix 9e3e13af63 2017-09-02 22:20:03 +04:00
norayr
bad584ec32 make bootstrap. 2017-08-08 15:39:44 +04:00
norayr
511186f0a4 applied temple's fix for the ofront issue #30, endless recoursion for
cyclic array types.
c7d37c9162
2017-08-08 15:37:29 +04:00
norayr
9f3893bb42 should fix library build. 2017-06-21 21:45:26 +04:00
norayr
e626e5c97d updated bootstrap sources. 2017-06-21 21:33:03 +04:00
norayr
211f69c89a moved strtoreal functions to strings module. 2017-06-21 20:58:10 +04:00
norayr
b5c76a0ee3 implemented In.Real and In.LongReal, unless it'll be implemented better. 2017-06-21 20:45:58 +04:00
David Brown
5c86750aed Enable Mac static linking. 2017-02-15 18:58:39 +00:00
David Brown
8063b0c595 Fix dynamic linking on Mac. Static linking not working. 2017-02-15 18:34:00 +00:00
David Brown
44d5e0f325 Remove obsolete LDCONFIG env var generation in configure.c 2017-01-02 12:00:36 +00:00
David Brown
284b105c80 Update bootstrap C sources. 2017-01-01 01:28:40 +00:00
David Brown
ba9498b592 Fix verbose display of gcc command. 2017-01-01 01:27:58 +00:00
David Brown
a4dfd37908 Update bootstrap C source. 2016-12-29 15:30:06 +00:00
David Brown
0666629e1e J. Templ heap tweaks - improved handling in extreme memory scenarios. 2016-12-29 15:28:04 +00:00
David Brown
6a20f8f951 Fix for dynamic library installation. 2016-12-28 14:47:16 +00:00
David Brown
ee6e5fe7b4 Update bootstrap C source 2016-12-28 13:06:10 +00:00
David Brown
265ac23f6e Restore 4*Unit heap allocation multiple. 2016-12-28 13:05:16 +00:00
David Brown
66b7ea0be0 Merge branch 'master' of https://github.com/vishaps/voc 2016-12-28 12:35:43 +00:00
David Brown
6c9fdacce5 Update bootstrap C source 2016-12-28 12:34:28 +00:00
David Brown
173c83f217 Integrate OFront fix for unsigned DIV in heap. 2016-12-28 12:33:34 +00:00
Norayr Chilingarian
2a65229fef added 'make install' to the readme. 2016-12-26 00:09:35 +04:00
David Brown
d292b4b2c9 Update bootstrap C sources. 2016-12-22 17:17:34 +00:00
David Brown
535f80d91c Integrate jtempl heap allocation recursion fix. 2016-12-22 17:16:42 +00:00
David Brown
37fc052d95 Update autobuild report 2016-12-22 16:36:05 +00:00
David Brown
b66d7bf2ef Display configuration in Visual C makefile 2016-12-22 14:55:03 +00:00
David Brown
4dac1f29d5 Fix conditional syntax in autobuild script. 2016-12-22 14:42:53 +00:00
David Brown
da14bc6398 Add Visual C x86 autobuild. 2016-12-22 14:35:11 +00:00
David Brown
572587ec56 Add new autobuild machine vim-obs32. 2016-12-21 18:16:25 +00:00
David Brown
ee197d741a Update C bootstrap source. 2016-12-21 13:02:11 +00:00
David Brown
3ba0d7ae2c Update Visual C make.cmd, use separate compilation for LOLA conf test. 2016-12-21 13:01:14 +00:00
259 changed files with 6466 additions and 3183 deletions

4
.gitattributes vendored
View file

@ -34,3 +34,7 @@
*.Mod diff=pascal *.Mod diff=pascal
*.c diff=cpp *.c diff=cpp
*.h diff=cpp *.h diff=cpp
# Set the language to Oberon
*.Mod linguist-language=Oberon
*.mod linguist-language=Oberon

9
.gitignore vendored
View file

@ -11,6 +11,7 @@
/*.sym /*.sym
/*.asm /*.asm
/*.mod /*.mod
/Errors.Txt
/Errors.txt /Errors.txt
/olang /olang
/src/test/**/*.exe /src/test/**/*.exe
@ -20,9 +21,11 @@
/src/test/**/*.obj /src/test/**/*.obj
/src/test/**/*.sym /src/test/**/*.sym
**/*.stackdump **/*.stackdump
!/src/test/confidence/**/expected
/src/test/confidence/**/input /src/test/confidence/**/input
/src/test/confidence/**/result /src/test/confidence/**/result
/src/test/confidence/**/result-* /src/test/confidence/**/result-*
/src/test/confidence/**/*[^.]*
/src/test/confidence/**/*.asm /src/test/confidence/**/*.asm
/src/test/confidence/**/*.s /src/test/confidence/**/*.s
/src/test/confidence/**/*.map /src/test/confidence/**/*.map
@ -35,3 +38,9 @@
**/.tmp.* **/.tmp.*
/*.pdb /*.pdb
/*.ilk /*.ilk
/t/*
/triage/BasicTypeSize.md
/triage/Roadmap.md
triage/system/*
tags
voc

View file

@ -1,12 +1,12 @@
[![Build status](http://brownsmeet.com/build-status.svg)](http://brownsmeet.com/log/) ![Build status](https://brownsmeet.com/githubhook/vishaps-status)
# Ѵishap Oberon # Ѵishap Oberon
[Ѵishap Oberon](http://oberon.vishap.am) is a free and open source (GPLv3) [Ѵishap Oberon](https://vishap.oberon.am/) is a free and open source (GPLv3)
implementation of the Oberon-2 language and libraries for use on implementation of the Oberon-2 language and libraries for use on
conventional operating systems such as Linux, BSD, Android, Mac and Windows. conventional operating systems such as Linux, BSD, Android, Mac and Windows.
Vishap's Oberon Compiler (voc) uses a C backend (gcc, clang or msc) to compile Vishap's Oberon Compiler (voc) uses a C backend (gcc, clang, tcc or msc) to compile
Oberon programs under Unix, Mac or Windows. Vishap Oberon includes Oberon programs under Unix, Mac or Windows. Vishap Oberon includes
libraries from the Ulm, oo2c and Ofront Oberon compilers, as well as libraries from the Ulm, oo2c and Ofront Oberon compilers, as well as
default libraries complying with the Oakwood Guidelines for Oberon-2 compilers. default libraries complying with the Oakwood Guidelines for Oberon-2 compilers.
@ -31,9 +31,11 @@ It is easy to install the Oberon compiler and libraries
with the following simple steps: with the following simple steps:
1. Install pre-requisites such as git, gcc, static C libraries, diff utils. 1. Install pre-requisites such as git, gcc, static C libraries, diff utils.
2. Clone the repository and run 'make full'. 2. Clone the repository: `git clone https://github.com/vishaps/voc`.
3. Optionally install to a system directory such as /opt or /usr/local/share. 3. Optionally `export CC=clang` or `export CC=tcc`.
4. Set your PATH variable to include the compiler binary. 4. run `make full`.
5. Optionally install to a system directory such as /opt or /usr/local/share with `make install` (might be with sudo).
6. Set your PATH variable to include the compiler binary.
These are detailed below: These are detailed below:
@ -74,7 +76,7 @@ for your OS as follows:
| ------- | -------------------------------------- | | ------- | -------------------------------------- |
| Linux | `/opt/voc` | | Linux | `/opt/voc` |
| BSD | `/usr/local/share/voc` | | BSD | `/usr/local/share/voc` |
| Windows | See [**Windows installation**](/doc/WInstallation.md) | | Windows | See [**Windows installation**](/doc/Winstallation.md) |
| Termux | `/data/data/com.termux/files/opt/voc` | | Termux | `/data/data/com.termux/files/opt/voc` |
`make install` updates `ldconfg` with the new library locations. `make install` updates `ldconfg` with the new library locations.
@ -95,7 +97,7 @@ For reference this will be:
| Just `make full` | `export PATH="your-repository-clone/install/bin:$PATH"` | | Just `make full` | `export PATH="your-repository-clone/install/bin:$PATH"` |
| `make install` on Linux | `export PATH="/opt/voc/bin:$PATH"` | | `make install` on Linux | `export PATH="/opt/voc/bin:$PATH"` |
| `make install` on BSD | `export PATH="/usr/local/share/voc/bin:$PATH"` | | `make install` on BSD | `export PATH="/usr/local/share/voc/bin:$PATH"` |
| `make install` on Windows | See [**Windows installation**](/doc/WInstallation.md) | | `make install` on Windows | See [**Windows installation**](/doc/Winstallation.md) |
| `make install` on Termux | `export PATH="/data/data/com.termux/files/opt/voc/bin:$PATH"` | | `make install` on Termux | `export PATH="/data/data/com.termux/files/opt/voc/bin:$PATH"` |
Also see [**Installation**](/doc/Installation.md). Also see [**Installation**](/doc/Installation.md).
@ -179,9 +181,9 @@ Most of the runtime in libVishapOberon is distributed under GPLv3 with runtime e
## Platform support and porting ## Platform support and porting
Vishap Oberon supports 32 and 64 bit little-endian architectures including Intel x86 and x64, arm and ppc. Vishap Oberon supports 32 and 64 bit little-endian architectures including Intel x86 and x86_64, 32 bit arm and aarch64.
It compiles under gcc, clang and Microsoft Visual C. It compiles under gcc, clang, tcc and Microsoft Visual C.
Installation supports GNU/Linux, MAC OSX, BSD and Windows (native and cygwin). Installation supports GNU/Linux, MAC OSX, BSD and Windows (native and cygwin).
@ -245,9 +247,7 @@ Norayr Chilingarian forked ofront in 2013, porting extensive libraries from [ULM
David Brown has worked on adding support for more platforms incuding windows using MSC, cygwin or mingw since January 2016. More recently he has generalised basic type support within the compiler to allow e.g. 64 bit LONGINT on 32 bit systems, and 32 bit LONGINT on 64 bit systems. David Brown has worked on adding support for more platforms incuding windows using MSC, cygwin or mingw since January 2016. More recently he has generalised basic type support within the compiler to allow e.g. 64 bit LONGINT on 32 bit systems, and 32 bit LONGINT on 64 bit systems.
## Origin of the name "Ѵishap Oberon" ## Oberon
#### Oberon
Oberon is a programming language, an operating system and a graphical Oberon is a programming language, an operating system and a graphical
user interface. Originally designed and implemented by by Niklaus Wirth and user interface. Originally designed and implemented by by Niklaus Wirth and
@ -266,7 +266,7 @@ of Einstein and Antoine de Saint-Exupéry:
> when there is no longer anything to take away. (Antoine de Saint-Exupéry, > when there is no longer anything to take away. (Antoine de Saint-Exupéry,
> translated by Lewis Galantière.) > translated by Lewis Galantière.)
#### Ѵishap ## Origin of the name "Ѵishap Oberon"
Vishaps are dragons inhabiting the Armenian Highlands. Vishaps are dragons inhabiting the Armenian Highlands.
We decided to name the project “Vishap” because ties between compilers and dragons have ancient traditions. We decided to name the project “Vishap” because ties between compilers and dragons have ancient traditions.
@ -278,13 +278,13 @@ Also, Vishaps are known in tales, fiction. [This page](http://blog.fogus.me/2015
###### Oberon ###### Oberon
- [The History of Modula-2 and Oberon](http://people.inf.ethz.ch/wirth/Articles/Modula-Oberon-June.pdf) - [The History of Modula-2 and Oberon](http://people.inf.ethz.ch/wirth/Articles/Modula-Oberon-June.pdf)
- [The Programming Language Oberon](https://www.inf.ethz.ch/personal/wirth/Oberon/Oberon.Report.pdf) - [The Programming Language Oberon](https://www.inf.ethz.ch/personal/wirth/Oberon/Oberon.Report.pdf)
- [Project Oberon: The Design of an Operating System and Compiler ](http://www.ethoberon.ethz.ch/WirthPubl/ProjectOberon.pdf) - [Project Oberon: The Design of an Operating System and Compiler ](https://people.inf.ethz.ch/wirth/ProjectOberon1992.pdf)
- [Oberon - the Overlooked Jewel](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.90.7173&rep=rep1&type=pdf) - [Oberon - the Overlooked Jewel](http://pascal.hansotten.com/uploads/oberonpi/Oberon%20article.pdf)
###### Oberon 2 ###### Oberon 2
- [Differences between Oberon and Oberon-2](http://members.home.nl/jmr272/Oberon/Oberon2.Differences.pdf) - [Differences between Oberon and Oberon-2](https://citeseerx.ist.psu.edu/document?repid=rep1&type=pdf&doi=89e5bd3cf006bde4821599cdc57a37de5dc84bcd)
- [The Programming Language Oberon-2](http://www.ssw.uni-linz.ac.at/Research/Papers/Oberon2.pdf) - [The Programming Language Oberon-2](http://www.ssw.uni-linz.ac.at/Research/Papers/Oberon2.pdf)
- [Programming in Oberon. Steps beyond Pascal and Modula](http://www.ethoberon.ethz.ch/WirthPubl/ProgInOberonWR.pdf) - [Programming in Oberon. Steps beyond Pascal and Modula](https://people.inf.ethz.ch/wirth/ProgInOberonWR.pdf)
- [The Oakwood Guidelines for Oberon-2 Compiler Developers](http://www.math.bas.bg/bantchev/place/oberon/oakwood-guidelines.pdf) - [The Oakwood Guidelines for Oberon-2 Compiler Developers](http://www.math.bas.bg/bantchev/place/oberon/oakwood-guidelines.pdf)
###### Oberon 07 ###### Oberon 07
@ -294,12 +294,12 @@ Also, Vishaps are known in tales, fiction. [This page](http://blog.fogus.me/2015
###### Links ###### Links
- [Niklaus Wirth's personal page at ETH Zurich](https://www.inf.ethz.ch/personal/wirth/) - [Niklaus Wirth's personal page at ETH Zurich](https://www.inf.ethz.ch/personal/wirth/)
- [ETH Zurich's Wirth publications page](http://www.ethoberon.ethz.ch/WirthPubl/) - [Selected articles by Niklaus Wirth](https://people.inf.ethz.ch/wirth/SelectedArticles.pdf)
- [Joseph Templ's ofront on github](https://hithub.com/jtempl/ofront) - [ETH Oberon publications page](https://web.archive.org/web/20191207155011/http://www.ethoberon.ethz.ch/books.html)
- [Joseph Templ's ofront on github](https://github.com/jtempl/ofront)
- [Software Templ OG](http://www.software-templ.com) - [Software Templ OG](http://www.software-templ.com)
- [Oberon: Steps beyond Pascal and Modula](http://fruttenboel.verhoeven272.nl/Oberon/)
## History ## History
See [**History**](/doc/History.md). See [**History**](/doc/History.md).

View file

@ -151,53 +151,61 @@ SYSTEM_PTR SYSTEM_NEWARR(ADDRESS *typ, ADDRESS elemsz, int elemalgn, int nofdim,
return x; return x;
} }
typedef void (*SystemSignalHandler)(INT32); // = Platform_SignalHandler typedef void (*SystemSignalHandler)(INT32); // = Platform_SignalHandler
#ifndef _WIN32 #ifndef _WIN32
// Unix signal handling
SystemSignalHandler handler[10] = {0}; // Adjust the array size to include signal 11
SystemSignalHandler handler[3] = {0}; void segfaultHandler(int signal) {
__HALT(-10);
// Provide signal handling for Unix based systems }
// Revised signal handler to accommodate additional signals like SIGSEGV
void signalHandler(int s) { void signalHandler(int s) {
if (s >= 2 && s <= 4) handler[s-2](s); if ((s >= 2 && s <= 4) || s == 11) { // Include SIGSEGV (usually signal 11)
// (Ignore other signals) if (handler[s-2]) {
handler[s-2](s);
}
}
// Ignore other signals
} }
void SystemSetHandler(int s, ADDRESS h) { void SystemSetHandler(int s, ADDRESS h) {
if (s >= 2 && s <= 4) { if ((s >= 2 && s <= 4) || s == 11) {
int needtosetsystemhandler = handler[s-2] == 0; int needtosetsystemhandler = handler[s-2] == 0;
handler[s-2] = (SystemSignalHandler)h; handler[s-2] = (SystemSignalHandler)h;
if (needtosetsystemhandler) {signal(s, signalHandler);} if (needtosetsystemhandler) {
signal(s, signalHandler);
}
} }
} }
#else void setupAutomaticSegfaultHandler() {
SystemSetHandler(11, (ADDRESS)segfaultHandler); // Register handler for SIGSEGV
}
// Provides Windows callback handlers for signal-like scenarios #else
// Windows system remains as is since Windows does not use SIGSEGV in the same way
#include "WindowsWrapper.h" #include "WindowsWrapper.h"
SystemSignalHandler SystemInterruptHandler = 0; SystemSignalHandler SystemInterruptHandler = 0;
SystemSignalHandler SystemQuitHandler = 0; SystemSignalHandler SystemQuitHandler = 0;
BOOL ConsoleCtrlHandlerSet = FALSE; BOOL ConsoleCtrlHandlerSet = FALSE;
BOOL WINAPI SystemConsoleCtrlHandler(DWORD ctrlType) { BOOL WINAPI SystemConsoleCtrlHandler(DWORD ctrlType) {
if ((ctrlType == CTRL_C_EVENT) || (ctrlType == CTRL_BREAK_EVENT)) { if ((ctrlType == CTRL_C_EVENT) || (ctrlType == CTRL_BREAK_EVENT)) {
if (SystemInterruptHandler) { if (SystemInterruptHandler) {
SystemInterruptHandler(2); // SIGINT SystemInterruptHandler(2); // SIGINT
return TRUE; return TRUE;
} }
} else { // Close, logoff or shutdown } else {
if (SystemQuitHandler) { if (SystemQuitHandler) {
SystemQuitHandler(3); // SIGQUIT SystemQuitHandler(3); // SIGQUIT
return TRUE; return TRUE;
} }
} }
return FALSE; return FALSE;
} }
void EnsureConsoleCtrlHandler() { void EnsureConsoleCtrlHandler() {
if (!ConsoleCtrlHandlerSet) { if (!ConsoleCtrlHandlerSet) {
SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE); SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE);
@ -216,3 +224,4 @@ typedef void (*SystemSignalHandler)(INT32); // = Platform_SignalHandler
} }
#endif #endif

View file

@ -19,7 +19,11 @@
typedef unsigned long size_t; typedef unsigned long size_t;
#endif #endif
#else #else
typedef unsigned int size_t; #if defined(__OpenBSD__)
typedef unsigned long size_t;
#else
typedef unsigned int size_t;
#endif
#endif #endif
#define _SIZE_T_DECLARED // For FreeBSD #define _SIZE_T_DECLARED // For FreeBSD
@ -112,9 +116,11 @@ extern void Modules_AssertFail(INT32 x);
// Index checking // Index checking
static inline INT64 __XF(UINT64 i, UINT64 ub) {if (i >= ub) {__HALT(-2);} return i;} static inline INT64 __XF(INT64 i, UINT64 ub) {
#define __X(i, ub) (((i)<(ub))?i:(__HALT(-2),0)) if (i < 0 || (UINT64)i >= ub) __HALT(-2);
return i;
}
#define __X(i, ub) (((i) >= 0 && (i) < (ub)) ? (i) : (__HALT(-2),0))
// Range checking, and checked SHORT and CHR functions // Range checking, and checked SHORT and CHR functions
@ -261,7 +267,12 @@ extern void Heap_INCREF();
extern void Modules_Init(INT32 argc, ADDRESS argv); extern void Modules_Init(INT32 argc, ADDRESS argv);
extern void Heap_FINALL(); extern void Heap_FINALL();
extern void setupAutomaticSegfaultHandler();
#ifndef _WIN32
#define __INIT(argc, argv) static void *m; setupAutomaticSegfaultHandler(); Modules_Init(argc, (ADDRESS)&argv);
#else
#define __INIT(argc, argv) static void *m; Modules_Init(argc, (ADDRESS)&argv); #define __INIT(argc, argv) static void *m; Modules_Init(argc, (ADDRESS)&argv);
#endif
#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum) #define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum)
#define __FINI Heap_FINALL(); return 0 #define __FINI Heap_FINALL(); return 0

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -89,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp; OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp; OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp; OPT_lintobj->typ = OPT_linttyp;
switch (OPM_LongintSize) { switch (OPM_SetSize) {
case 4: case 4:
OPT_settyp = OPT_set32typ; OPT_settyp = OPT_set32typ;
break; break;

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -8,7 +8,7 @@
#include "SYSTEM.h" #include "SYSTEM.h"
export CHAR Configuration_versionLong[75]; export CHAR Configuration_versionLong[76];
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD; __DEFMOD;
__REGMOD("Configuration", 0); __REGMOD("Configuration", 0);
/* BEGIN */ /* BEGIN */
__MOVE("2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); __MOVE("2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76);
__ENDMOD; __ENDMOD;
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Configuration__h #ifndef Configuration__h
#define Configuration__h #define Configuration__h
@ -6,7 +6,7 @@
#include "SYSTEM.h" #include "SYSTEM.h"
import CHAR Configuration_versionLong[75]; import CHAR Configuration_versionLong[76];
import void *Configuration__init(void); import void *Configuration__init(void);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -26,7 +26,7 @@ typedef
Files_BufDesc *Files_Buffer; Files_BufDesc *Files_Buffer;
typedef typedef
CHAR Files_FileName[101]; CHAR Files_FileName[256];
typedef typedef
struct Files_FileDesc { struct Files_FileDesc {
@ -48,6 +48,7 @@ typedef
} Files_Rider; } Files_Rider;
export INT16 Files_MaxPathLength, Files_MaxNameLength;
static Files_FileDesc *Files_files; static Files_FileDesc *Files_files;
static INT16 Files_tempno; static INT16 Files_tempno;
static CHAR Files_HOME[1024]; static CHAR Files_HOME[1024];
@ -85,6 +86,7 @@ export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f); export void Files_Purge (Files_File f);
export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
export void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
@ -129,17 +131,17 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
Out_String((CHAR*)": ", 3); Out_String((CHAR*)": ", 3);
if (f != NIL) { if (f != NIL) {
if (f->registerName[0] != 0x00) { if (f->registerName[0] != 0x00) {
Out_String(f->registerName, 101); Out_String(f->registerName, 256);
} else { } else {
Out_String(f->workName, 101); Out_String(f->workName, 256);
} }
if (f->fd != 0) { if (f->fd != 0) {
Out_String((CHAR*)"f.fd = ", 8); Out_String((CHAR*)", f.fd = ", 10);
Out_Int(f->fd, 1); Out_Int(f->fd, 1);
} }
} }
if (errcode != 0) { if (errcode != 0) {
Out_String((CHAR*)" errcode = ", 12); Out_String((CHAR*)", errcode = ", 13);
Out_Int(errcode, 1); Out_Int(errcode, 1);
} }
Out_Ln(); Out_Ln();
@ -149,76 +151,75 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len) static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len)
{ {
INT16 i, j; INT16 i, j, ld, ln;
__DUP(dir, dir__len, CHAR); __DUP(dir, dir__len, CHAR);
__DUP(name, name__len, CHAR); __DUP(name, name__len, CHAR);
ld = Strings_Length(dir, dir__len);
ln = Strings_Length(name, name__len);
while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) {
ld -= 1;
}
if (((ld + ln) + 2) > dest__len) {
Files_Err((CHAR*)"File name too long", 19, NIL, 0);
}
i = 0; i = 0;
while (i < ld) {
dest[__X(i, dest__len)] = dir[__X(i, dir__len)];
i += 1;
}
if (i > 0) {
dest[__X(i, dest__len)] = '/';
i += 1;
}
j = 0; j = 0;
while (dir[i] != 0x00) { while (j < ln) {
dest[i] = dir[i]; dest[__X(i, dest__len)] = name[__X(j, name__len)];
i += 1;
}
if (dest[i - 1] != '/') {
dest[i] = '/';
i += 1;
}
while (name[j] != 0x00) {
dest[i] = name[j];
i += 1; i += 1;
j += 1; j += 1;
} }
dest[i] = 0x00; dest[__X(i, dest__len)] = 0x00;
__DEL(dir); __DEL(dir);
__DEL(name); __DEL(name);
} }
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len) static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len)
{ {
INT32 n, i, j; INT16 i, n;
__DUP(finalName, finalName__len, CHAR); __DUP(finalName, finalName__len, CHAR);
Files_tempno += 1; if (finalName[0] == '/') {
n = Files_tempno; __COPY(finalName, name, name__len);
i = 0; } else {
if (finalName[0] != '/') { Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len);
while (Platform_CWD[i] != 0x00) {
name[i] = Platform_CWD[i];
i += 1;
}
if (Platform_CWD[i - 1] != '/') {
name[i] = '/';
i += 1;
}
} }
j = 0; i = Strings_Length(name, name__len) - 1;
while (finalName[j] != 0x00) { while ((i > 0 && name[__X(i, name__len)] != '/')) {
name[i] = finalName[j];
i += 1;
j += 1;
}
i -= 1;
while (name[i] != '/') {
i -= 1; i -= 1;
} }
name[i + 1] = '.'; if ((i + 16) >= name__len) {
name[i + 2] = 't'; Files_Err((CHAR*)"File name too long", 19, NIL, 0);
name[i + 3] = 'm'; }
name[i + 4] = 'p'; Files_tempno += 1;
name[i + 5] = '.'; n = Files_tempno;
name[__X(i + 1, name__len)] = '.';
name[__X(i + 2, name__len)] = 't';
name[__X(i + 3, name__len)] = 'm';
name[__X(i + 4, name__len)] = 'p';
name[__X(i + 5, name__len)] = '.';
i += 6; i += 6;
while (n > 0) { while (n > 0) {
name[i] = (CHAR)((int)__MOD(n, 10) + 48); name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
n = __DIV(n, 10); n = __DIV(n, 10);
i += 1; i += 1;
} }
name[i] = '.'; name[__X(i, name__len)] = '.';
i += 1; i += 1;
n = Platform_PID; n = Platform_PID;
while (n > 0) { while (n > 0) {
name[i] = (CHAR)((int)__MOD(n, 10) + 48); name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
n = __DIV(n, 10); n = __DIV(n, 10);
i += 1; i += 1;
} }
name[i] = 0x00; name[__X(i, name__len)] = 0x00;
__DEL(finalName); __DEL(finalName);
} }
@ -236,11 +237,11 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len)
if (osfile != NIL) { if (osfile != NIL) {
__ASSERT(!osfile->tempFile, 0); __ASSERT(!osfile->tempFile, 0);
__ASSERT(osfile->fd >= 0, 0); __ASSERT(osfile->fd >= 0, 0);
__MOVE(osfile->workName, osfile->registerName, 101); __MOVE(osfile->workName, osfile->registerName, 256);
Files_GetTempName(osfile->registerName, 101, (void*)osfile->workName, 101); Files_GetTempName(osfile->registerName, 256, (void*)osfile->workName, 256);
osfile->tempFile = 1; osfile->tempFile = 1;
osfile->state = 0; osfile->state = 0;
error = Platform_Rename((void*)osfile->registerName, 101, (void*)osfile->workName, 101); error = Platform_Rename((void*)osfile->registerName, 256, (void*)osfile->workName, 256);
if (error != 0) { if (error != 0) {
Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error); Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error);
} }
@ -256,17 +257,17 @@ static void Files_Create (Files_File f)
CHAR err[32]; CHAR err[32];
if (f->fd == -1) { if (f->fd == -1) {
if (f->state == 1) { if (f->state == 1) {
Files_GetTempName(f->registerName, 101, (void*)f->workName, 101); Files_GetTempName(f->registerName, 256, (void*)f->workName, 256);
f->tempFile = 1; f->tempFile = 1;
} else { } else {
__ASSERT(f->state == 2, 0); __ASSERT(f->state == 2, 0);
Files_Deregister(f->registerName, 101); Files_Deregister(f->registerName, 256);
__MOVE(f->registerName, f->workName, 101); __MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00; f->registerName[0] = 0x00;
f->tempFile = 0; f->tempFile = 0;
} }
error = Platform_Unlink((void*)f->workName, 101); error = Platform_Unlink((void*)f->workName, 256);
error = Platform_New((void*)f->workName, 101, &f->fd); error = Platform_New((void*)f->workName, 256, &f->fd);
done = error == 0; done = error == 0;
if (done) { if (done) {
f->next = Files_files; f->next = Files_files;
@ -319,8 +320,8 @@ void Files_Close (Files_File f)
if (f->state != 1 || f->registerName[0] != 0x00) { if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f); Files_Create(f);
i = 0; i = 0;
while ((i < 4 && f->bufs[i] != NIL)) { while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) {
Files_Flush(f->bufs[i]); Files_Flush(f->bufs[__X(i, 4)]);
i += 1; i += 1;
} }
} }
@ -337,7 +338,7 @@ Files_File Files_New (CHAR *name, ADDRESS name__len)
__DUP(name, name__len, CHAR); __DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc); __NEW(f, Files_FileDesc);
f->workName[0] = 0x00; f->workName[0] = 0x00;
__COPY(name, f->registerName, 101); __COPY(name, f->registerName, 256);
f->fd = -1; f->fd = -1;
f->state = 1; f->state = 1;
f->len = 0; f->len = 0;
@ -359,35 +360,35 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
*pos += 1; *pos += 1;
} }
} else { } else {
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (ch == ' ' || ch == ';') { while (ch == ' ' || ch == ';') {
*pos += 1; *pos += 1;
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
} }
if (ch == '~') { if (ch == '~') {
*pos += 1; *pos += 1;
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (Files_HOME[i] != 0x00) { while (Files_HOME[__X(i, 1024)] != 0x00) {
dir[i] = Files_HOME[i]; dir[__X(i, dir__len)] = Files_HOME[__X(i, 1024)];
i += 1; i += 1;
} }
if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) {
while ((i > 0 && dir[i - 1] != '/')) { while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) {
i -= 1; i -= 1;
} }
} }
} }
while ((ch != 0x00 && ch != ';')) { while ((ch != 0x00 && ch != ';')) {
dir[i] = ch; dir[__X(i, dir__len)] = ch;
i += 1; i += 1;
*pos += 1; *pos += 1;
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
} }
while ((i > 0 && dir[i - 1] == ' ')) { while ((i > 0 && dir[__X(i - 1, dir__len)] == ' ')) {
i -= 1; i -= 1;
} }
} }
dir[i] = 0x00; dir[__X(i, dir__len)] = 0x00;
} }
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
@ -398,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
ch = name[0]; ch = name[0];
while ((ch != 0x00 && ch != '/')) { while ((ch != 0x00 && ch != '/')) {
i += 1; i += 1;
ch = name[i]; ch = name[__X(i, name__len)];
} }
return ch == '/'; return ch == '/';
} }
@ -413,9 +414,9 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
if (!Platform_SameFileTime(identity, f->identity)) { if (!Platform_SameFileTime(identity, f->identity)) {
i = 0; i = 0;
while (i < 4) { while (i < 4) {
if (f->bufs[i] != NIL) { if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[i]->org = -1; f->bufs[__X(i, 4)]->org = -1;
f->bufs[i] = NIL; f->bufs[__X(i, 4)] = NIL;
} }
i += 1; i += 1;
} }
@ -482,7 +483,7 @@ Files_File Files_Old (CHAR *name, ADDRESS name__len)
f->pos = 0; f->pos = 0;
f->swapper = -1; f->swapper = -1;
error = Platform_Size(fd, &f->len); error = Platform_Size(fd, &f->len);
__COPY(name, f->workName, 101); __COPY(name, f->workName, 256);
f->registerName[0] = 0x00; f->registerName[0] = 0x00;
f->tempFile = 0; f->tempFile = 0;
f->identity = identity; f->identity = identity;
@ -514,9 +515,9 @@ void Files_Purge (Files_File f)
INT16 error; INT16 error;
i = 0; i = 0;
while (i < 4) { while (i < 4) {
if (f->bufs[i] != NIL) { if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[i]->org = -1; f->bufs[__X(i, 4)]->org = -1;
f->bufs[i] = NIL; f->bufs[__X(i, 4)] = NIL;
} }
i += 1; i += 1;
} }
@ -560,22 +561,22 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
offset = __MASK(pos, -4096); offset = __MASK(pos, -4096);
org = pos - offset; org = pos - offset;
i = 0; i = 0;
while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { while ((((i < 4 && f->bufs[__X(i, 4)] != NIL)) && org != f->bufs[__X(i, 4)]->org)) {
i += 1; i += 1;
} }
if (i < 4) { if (i < 4) {
if (f->bufs[i] == NIL) { if (f->bufs[__X(i, 4)] == NIL) {
__NEW(buf, Files_BufDesc); __NEW(buf, Files_BufDesc);
buf->chg = 0; buf->chg = 0;
buf->org = -1; buf->org = -1;
buf->f = f; buf->f = f;
f->bufs[i] = buf; f->bufs[__X(i, 4)] = buf;
} else { } else {
buf = f->bufs[i]; buf = f->bufs[__X(i, 4)];
} }
} else { } else {
f->swapper = __MASK(f->swapper + 1, -4); f->swapper = __MASK(f->swapper + 1, -4);
buf = f->bufs[f->swapper]; buf = f->bufs[__X(f->swapper, 4)];
Files_Flush(buf); Files_Flush(buf);
} }
if (buf->org != org) { if (buf->org != org) {
@ -622,7 +623,7 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
} }
Files_Assert(offset <= buf->size); Files_Assert(offset <= buf->size);
if (offset < buf->size) { if (offset < buf->size) {
*x = buf->data[offset]; *x = buf->data[__X(offset, 4096)];
(*r).offset = offset + 1; (*r).offset = offset + 1;
} else if ((*r).org + offset < buf->f->len) { } else if ((*r).org + offset < buf->f->len) {
Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset);
@ -634,6 +635,11 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
} }
} }
void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
{
Files_Read(&*r, r__typ, &*x);
}
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n) void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
{ {
INT32 xpos, min, restInBuf, offset; INT32 xpos, min, restInBuf, offset;
@ -660,7 +666,7 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x
} else { } else {
min = n; min = n;
} }
__MOVE((ADDRESS)&buf->data[offset], (ADDRESS)&x[xpos], min); __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
offset += min; offset += min;
(*r).offset = offset; (*r).offset = offset;
xpos += min; xpos += min;
@ -689,7 +695,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
offset = (*r).offset; offset = (*r).offset;
} }
Files_Assert(offset < 4096); Files_Assert(offset < 4096);
buf->data[offset] = x; buf->data[__X(offset, 4096)] = x;
buf->chg = 1; buf->chg = 1;
if (offset == buf->size) { if (offset == buf->size) {
buf->size += 1; buf->size += 1;
@ -723,7 +729,7 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS
} else { } else {
min = n; min = n;
} }
__MOVE((ADDRESS)&x[xpos], (ADDRESS)&buf->data[offset], min); __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
offset += min; offset += min;
(*r).offset = offset; (*r).offset = offset;
Files_Assert(offset <= 4096); Files_Assert(offset <= 4096);
@ -817,12 +823,12 @@ void Files_Register (Files_File f)
} }
Files_Close(f); Files_Close(f);
if (f->registerName[0] != 0x00) { if (f->registerName[0] != 0x00) {
Files_Deregister(f->registerName, 101); Files_Deregister(f->registerName, 256);
Files_Rename(f->workName, 101, f->registerName, 101, &errcode); Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
if (errcode != 0) { if (errcode != 0) {
Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode); Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
} }
__MOVE(f->registerName, f->workName, 101); __MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00; f->registerName[0] = 0x00;
f->tempFile = 0; f->tempFile = 0;
} }
@ -843,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *de
j = 0; j = 0;
while (i > 0) { while (i > 0) {
i -= 1; i -= 1;
dest[j] = src[i]; dest[__X(j, dest__len)] = src[__X(i, src__len)];
j += 1; j += 1;
} }
} else { } else {
@ -900,7 +906,7 @@ void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
i = 0; i = 0;
do { do {
Files_Read(&*R, R__typ, (void*)&ch); Files_Read(&*R, R__typ, (void*)&ch);
x[i] = ch; x[__X(i, x__len)] = ch;
i += 1; i += 1;
} while (!(ch == 0x00)); } while (!(ch == 0x00));
} }
@ -910,16 +916,16 @@ void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
INT16 i; INT16 i;
i = 0; i = 0;
do { do {
Files_Read(&*R, R__typ, (void*)&x[i]); Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]);
i += 1; i += 1;
} while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a)); } while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a));
if (x[i - 1] == 0x0a) { if (x[__X(i - 1, x__len)] == 0x0a) {
i -= 1; i -= 1;
} }
if ((i > 0 && x[i - 1] == 0x0d)) { if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) {
i -= 1; i -= 1;
} }
x[i] = 0x00; x[__X(i, x__len)] = 0x00;
} }
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len) void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
@ -947,18 +953,18 @@ void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x)
void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x) void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x)
{ {
CHAR b[2]; CHAR b[2];
b[0] = (CHAR)x; b[0] = __CHR(x);
b[1] = (CHAR)__ASHR(x, 8); b[1] = __CHR(__ASHR(x, 8));
Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2); Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2);
} }
void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x) void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x)
{ {
CHAR b[4]; CHAR b[4];
b[0] = (CHAR)x; b[0] = __CHR(x);
b[1] = (CHAR)__ASHR(x, 8); b[1] = __CHR(__ASHR(x, 8));
b[2] = (CHAR)__ASHR(x, 16); b[2] = __CHR(__ASHR(x, 16));
b[3] = (CHAR)__ASHR(x, 24); b[3] = __CHR(__ASHR(x, 24));
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
} }
@ -966,11 +972,13 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{ {
CHAR b[4]; CHAR b[4];
INT32 i; INT32 i;
i = (INT32)x; UINT64 y;
b[0] = (CHAR)i; y = x;
b[1] = (CHAR)__ASHR(i, 8); i = __VAL(INT32, y);
b[2] = (CHAR)__ASHR(i, 16); b[0] = __CHR(i);
b[3] = (CHAR)__ASHR(i, 24); b[1] = __CHR(__ASHR(i, 8));
b[2] = __CHR(__ASHR(i, 16));
b[3] = __CHR(__ASHR(i, 24));
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
} }
@ -992,7 +1000,7 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len
{ {
INT16 i; INT16 i;
i = 0; i = 0;
while (x[i] != 0x00) { while (x[__X(i, x__len)] != 0x00) {
i += 1; i += 1;
} }
Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1); Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
@ -1001,10 +1009,10 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len
void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x) void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{ {
while (x < -64 || x > 63) { while (x < -64 || x > 63) {
Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); Files_Write(&*R, R__typ, __CHR(__MASK(x, -128) + 128));
x = __ASHR(x, 7); x = __ASHR(x, 7);
} }
Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); Files_Write(&*R, R__typ, __CHR(__MASK(x, -128)));
} }
void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len) void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
@ -1041,7 +1049,7 @@ static void Files_Finalize (SYSTEM_PTR o)
if (f->fd >= 0) { if (f->fd >= 0) {
Files_CloseOSFile(f); Files_CloseOSFile(f);
if (f->tempFile) { if (f->tempFile) {
res = Platform_Unlink((void*)f->workName, 101); res = Platform_Unlink((void*)f->workName, 256);
} }
} }
} }
@ -1063,7 +1071,7 @@ static void EnumPtrs(void (*P)(void*))
P(Files_SearchPath); P(Files_SearchPath);
} }
__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 252), {228, 232, 236, 240, -20}}; __TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 564), {540, 544, 548, 552, -20}};
__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}}; __TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}};
__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}}; __TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}};
@ -1083,5 +1091,7 @@ export void *Files__init(void)
Heap_FileCount = 0; Heap_FileCount = 0;
Files_HOME[0] = 0x00; Files_HOME[0] = 0x00;
Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024); Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024);
Files_MaxPathLength = Platform_MaxPathLength();
Files_MaxNameLength = Platform_MaxNameLength();
__ENDMOD; __ENDMOD;
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Files__h #ifndef Files__h
#define Files__h #define Files__h
@ -11,7 +11,7 @@ typedef
typedef typedef
struct Files_FileDesc { struct Files_FileDesc {
INT32 _prvt0; INT32 _prvt0;
char _prvt1[248]; char _prvt1[560];
} Files_FileDesc; } Files_FileDesc;
typedef typedef
@ -22,6 +22,7 @@ typedef
} Files_Rider; } Files_Rider;
import INT16 Files_MaxPathLength, Files_MaxNameLength;
import ADDRESS *Files_FileDesc__typ; import ADDRESS *Files_FileDesc__typ;
import ADDRESS *Files_Rider__typ; import ADDRESS *Files_Rider__typ;
@ -39,6 +40,7 @@ import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
import void Files_Purge (Files_File f); import void Files_Purge (Files_File f);
import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
import void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -68,9 +68,10 @@ static INT32 Heap_freeList[10];
static INT32 Heap_bigBlocks; static INT32 Heap_bigBlocks;
export INT32 Heap_allocated; export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry; static BOOLEAN Heap_firstTry;
static INT16 Heap_ldUnit;
export INT32 Heap_heap; export INT32 Heap_heap;
static INT32 Heap_heapMin, Heap_heapMax; static INT32 Heap_heapMin, Heap_heapMax;
export INT32 Heap_heapsize; export INT32 Heap_heapsize, Heap_heapMinExpand;
static Heap_FinNode Heap_fin; static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth; static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted; static BOOLEAN Heap_interrupted;
@ -228,10 +229,10 @@ static INT32 Heap_NewChunk (INT32 blksz)
static void Heap_ExtendHeap (INT32 blksz) static void Heap_ExtendHeap (INT32 blksz)
{ {
INT32 size, chnk, j, next; INT32 size, chnk, j, next;
if (Heap_uLT(160000, blksz)) { if (Heap_uLT(Heap_heapMinExpand, blksz)) {
size = blksz; size = blksz;
} else { } else {
size = 160000; size = Heap_heapMinExpand;
} }
chnk = Heap_NewChunk(size); chnk = Heap_NewChunk(size);
if (chnk != 0) { if (chnk != 0) {
@ -248,6 +249,8 @@ static void Heap_ExtendHeap (INT32 blksz)
__PUT(chnk, next, INT32); __PUT(chnk, next, INT32);
__PUT(j, chnk, INT32); __PUT(j, chnk, INT32);
} }
} else if (!Heap_firstTry) {
Heap_heapMinExpand = 16;
} }
} }
@ -257,16 +260,16 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
SYSTEM_PTR new; SYSTEM_PTR new;
Heap_Lock(); Heap_Lock();
__GET(tag, blksz, INT32); __GET(tag, blksz, INT32);
i0 = __ASHR(blksz, 4); i0 = __LSH(blksz, -Heap_ldUnit, 32);
i = i0; i = i0;
if (Heap_uLT(i, 9)) { if (i < 9) {
adr = Heap_freeList[i]; adr = Heap_freeList[i];
while (adr == 0) { while (adr == 0) {
i += 1; i += 1;
adr = Heap_freeList[i]; adr = Heap_freeList[i];
} }
} }
if (Heap_uLT(i, 9)) { if (i < 9) {
__GET(adr + 12, next, INT32); __GET(adr + 12, next, INT32);
Heap_freeList[i] = next; Heap_freeList[i] = next;
if (i != i0) { if (i != i0) {
@ -289,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
if (Heap_firstTry) { if (Heap_firstTry) {
Heap_GC(1); Heap_GC(1);
blksz += 16; blksz += 16;
if (Heap_uLT(Heap_heapsize - Heap_allocated, blksz) || Heap_uLT(__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2), Heap_heapsize)) { t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 32) * 80;
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); if (Heap_uLT(Heap_heapsize, t)) {
Heap_ExtendHeap(t - Heap_heapsize);
} }
Heap_firstTry = 0; Heap_firstTry = 0;
new = Heap_NEWREC(tag); new = Heap_NEWREC(tag);
Heap_firstTry = 1;
if (new == NIL) { if (new == NIL) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); Heap_ExtendHeap(blksz);
new = Heap_NEWREC(tag); new = Heap_NEWREC(tag);
} }
Heap_firstTry = 1;
Heap_Unlock(); Heap_Unlock();
return new; return new;
} else { } else {
@ -443,7 +447,7 @@ static void Heap_Scan (void)
__PUT(start, start + 4, INT32); __PUT(start, start + 4, INT32);
__PUT(start + 4, freesize, INT32); __PUT(start + 4, freesize, INT32);
__PUT(start + 8, -4, INT32); __PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4); i = __LSH(freesize, -Heap_ldUnit, 32);
freesize = 0; freesize = 0;
if (Heap_uLT(i, 9)) { if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32); __PUT(start + 12, Heap_freeList[i], INT32);
@ -469,7 +473,7 @@ static void Heap_Scan (void)
__PUT(start, start + 4, INT32); __PUT(start, start + 4, INT32);
__PUT(start + 4, freesize, INT32); __PUT(start + 4, freesize, INT32);
__PUT(start + 8, -4, INT32); __PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4); i = __LSH(freesize, -Heap_ldUnit, 32);
freesize = 0; freesize = 0;
if (Heap_uLT(i, 9)) { if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32); __PUT(start + 12, Heap_freeList[i], INT32);
@ -661,79 +665,77 @@ void Heap_GC (BOOLEAN markStack)
Heap_Module m; Heap_Module m;
INT32 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; INT32 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
INT32 cand[10000]; INT32 cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { Heap_Lock();
Heap_Lock(); m = (Heap_Module)(ADDRESS)Heap_modules;
m = (Heap_Module)(ADDRESS)Heap_modules; while (m != NIL) {
while (m != NIL) { if (m->enumPtrs != NIL) {
if (m->enumPtrs != NIL) { (*m->enumPtrs)(Heap_MarkP);
(*m->enumPtrs)(Heap_MarkP);
}
m = m->next;
} }
if (markStack) { m = m->next;
i0 = -100;
i1 = -101;
i2 = -102;
i3 = -103;
i4 = -104;
i5 = -105;
i6 = -106;
i7 = -107;
i8 = 1;
i9 = 2;
i10 = 3;
i11 = 4;
i12 = 5;
i13 = 6;
i14 = 7;
i15 = 8;
i16 = 9;
i17 = 10;
i18 = 11;
i19 = 12;
i20 = 13;
i21 = 14;
i22 = 15;
i23 = 16;
for (;;) {
i0 += 1;
i1 += 2;
i2 += 3;
i3 += 4;
i4 += 5;
i5 += 6;
i6 += 7;
i7 += 8;
i8 += 9;
i9 += 10;
i10 += 11;
i11 += 12;
i12 += 13;
i13 += 14;
i14 += 15;
i15 += 16;
i16 += 17;
i17 += 18;
i18 += 19;
i19 += 20;
i20 += 21;
i21 += 22;
i22 += 23;
i23 += 24;
if ((i0 == -99 && i15 == 24)) {
Heap_MarkStack(32, (void*)cand, 10000);
break;
}
}
if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) {
return;
}
}
Heap_CheckFin();
Heap_Scan();
Heap_Finalize();
Heap_Unlock();
} }
if (markStack) {
i0 = -100;
i1 = -101;
i2 = -102;
i3 = -103;
i4 = -104;
i5 = -105;
i6 = -106;
i7 = -107;
i8 = 1;
i9 = 2;
i10 = 3;
i11 = 4;
i12 = 5;
i13 = 6;
i14 = 7;
i15 = 8;
i16 = 9;
i17 = 10;
i18 = 11;
i19 = 12;
i20 = 13;
i21 = 14;
i22 = 15;
i23 = 16;
for (;;) {
i0 += 1;
i1 += 2;
i2 += 3;
i3 += 4;
i4 += 5;
i5 += 6;
i6 += 7;
i7 += 8;
i8 += 9;
i9 += 10;
i10 += 11;
i11 += 12;
i12 += 13;
i13 += 14;
i14 += 15;
i15 += 16;
i16 += 17;
i17 += 18;
i18 += 19;
i19 += 20;
i20 += 21;
i21 += 22;
i22 += 23;
i23 += 24;
if ((i0 == -99 && i15 == 24)) {
Heap_MarkStack(32, (void*)cand, 10000);
break;
}
}
if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) {
return;
}
}
Heap_CheckFin();
Heap_Scan();
Heap_Finalize();
Heap_Unlock();
} }
void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize) void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
@ -756,6 +758,8 @@ void Heap_InitHeap (void)
Heap_heapMin = -1; Heap_heapMin = -1;
Heap_heapMax = 0; Heap_heapMax = 0;
Heap_bigBlocks = 0; Heap_bigBlocks = 0;
Heap_heapMinExpand = 128000;
Heap_ldUnit = 4;
Heap_heap = Heap_NewChunk(128000); Heap_heap = Heap_NewChunk(128000);
__PUT(Heap_heap, 0, INT32); __PUT(Heap_heap, 0, INT32);
Heap_firstTry = 1; Heap_firstTry = 1;

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#ifndef Heap__h #ifndef Heap__h
#define Heap__h #define Heap__h
@ -48,7 +48,7 @@ typedef
import SYSTEM_PTR Heap_modules; import SYSTEM_PTR Heap_modules;
import INT32 Heap_allocated; import INT32 Heap_allocated;
import INT32 Heap_heap; import INT32 Heap_heap;
import INT32 Heap_heapsize; import INT32 Heap_heapsize, Heap_heapMinExpand;
import INT16 Heap_FileCount; import INT16 Heap_FileCount;
import ADDRESS *Heap_ModuleDesc__typ; import ADDRESS *Heap_ModuleDesc__typ;

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -404,7 +404,7 @@ static void Modules_errint (INT32 l)
if (l >= 10) { if (l >= 10) {
Modules_errint(__DIV(l, 10)); Modules_errint(__DIV(l, 10));
} }
Modules_errch((CHAR)((int)__MOD(l, 10) + 48)); Modules_errch(__CHR((int)__MOD(l, 10) + 48));
} }
static void Modules_DisplayHaltCode (INT32 code) static void Modules_DisplayHaltCode (INT32 code)

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Modules__h #ifndef Modules__h
#define Modules__h #define Modules__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -261,7 +261,7 @@ static void OPB_CharToString (OPT_Node n)
{ {
CHAR ch; CHAR ch;
n->typ = OPT_stringtyp; n->typ = OPT_stringtyp;
ch = (CHAR)n->conval->intval; ch = __CHR(n->conval->intval);
n->conval->ext = OPT_NewExt(); n->conval->ext = OPT_NewExt();
if (ch == 0x00) { if (ch == 0x00) {
n->conval->intval2 = 1; n->conval->intval2 = 1;
@ -597,7 +597,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
case 22: case 22:
if (f == 3) { if (f == 3) {
if (z->class == 7) { if (z->class == 7) {
z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval); z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__29(op, typ, z);
@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203); OPB_err(203);
r = (LONGREAL)1; r = (LONGREAL)1;
} }
(*x)->conval->intval = (INT32)__ENTIER(r); (*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL);
OPB_SetIntType(*x); OPB_SetIntType(*x);
} }
} }
@ -1626,6 +1626,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
if (x == y) { if (x == y) {
} else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) { } else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) {
} else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) { } else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) {
OPB_err(113);
} else if (x->BaseTyp == OPT_chartyp) { } else if (x->BaseTyp == OPT_chartyp) {
if (g == 8) { if (g == 8) {
if (ynode->conval->intval2 > x->n) { if (ynode->conval->intval2 > x->n) {

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPB__h #ifndef OPB__h
#define OPB__h #define OPB__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -618,31 +618,33 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
{ {
if (obj != NIL) { if (obj != NIL) {
OPC_DefineTProcMacros(obj->left, &*empty); OPC_DefineTProcMacros(obj->left, &*empty);
if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) { if ((obj->mode == 13 && obj == OPC_BaseTProc(obj))) {
OPM_WriteString((CHAR*)"#define __", 11); if (OPM_currFile == 1 || (OPM_currFile == 0 && obj->vis == 1)) {
OPC_Ident(obj); OPM_WriteString((CHAR*)"#define __", 11);
OPC_DeclareParams(obj->link, 1); OPC_Ident(obj);
OPM_WriteString((CHAR*)" __SEND(", 9); OPC_DeclareParams(obj->link, 1);
if (obj->link->typ->form == 11) { OPM_WriteString((CHAR*)" __SEND(", 9);
OPM_WriteString((CHAR*)"__TYPEOF(", 10); if (obj->link->typ->form == 11) {
OPC_Ident(obj->link); OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPC_Ident(obj->link);
OPM_Write(')');
} else {
OPC_Ident(obj->link);
OPM_WriteString((CHAR*)"__typ", 6);
}
OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
if (obj->typ == OPT_notyp) {
OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(obj->typ->strobj);
}
OPM_WriteString((CHAR*)"(*)", 4);
OPC_AnsiParamList(obj->link, 0);
OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareParams(obj->link, 1);
OPM_Write(')'); OPM_Write(')');
} else { OPM_WriteLn();
OPC_Ident(obj->link);
OPM_WriteString((CHAR*)"__typ", 6);
} }
OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
if (obj->typ == OPT_notyp) {
OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(obj->typ->strobj);
}
OPM_WriteString((CHAR*)"(*)", 4);
OPC_AnsiParamList(obj->link, 0);
OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareParams(obj->link, 1);
OPM_Write(')');
OPM_WriteLn();
} }
OPC_DefineTProcMacros(obj->right, &*empty); OPC_DefineTProcMacros(obj->right, &*empty);
} }
@ -652,7 +654,7 @@ static void OPC_DefineType (OPT_Struct str)
{ {
OPT_Object obj = NIL, field = NIL, par = NIL; OPT_Object obj = NIL, field = NIL, par = NIL;
BOOLEAN empty; BOOLEAN empty;
if (OPM_currFile == 1 || str->ref < 255) { if ((OPM_currFile == 1 || str->ref < 255) || (((OPM_currFile == 0 && str->strobj != NIL)) && str->strobj->vis == 1)) {
obj = str->strobj; obj = str->strobj;
if (obj == NIL || OPC_Undefined(obj)) { if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) { if (obj != NIL) {
@ -681,6 +683,10 @@ static void OPC_DefineType (OPT_Struct str)
OPC_DefineType(str->BaseTyp); OPC_DefineType(str->BaseTyp);
} }
} else if (__IN(str->comp, 0x0c, 32)) { } else if (__IN(str->comp, 0x0c, 32)) {
if ((str->BaseTyp->strobj != NIL && str->BaseTyp->strobj->linkadr == 1)) {
OPM_Mark(244, str->txtpos);
str->BaseTyp->strobj->linkadr = 2;
}
OPC_DefineType(str->BaseTyp); OPC_DefineType(str->BaseTyp);
} else if (str->form == 12) { } else if (str->form == 12) {
if (str->BaseTyp != OPT_notyp) { if (str->BaseTyp != OPT_notyp) {
@ -715,6 +721,13 @@ static void OPC_DefineType (OPT_Struct str)
if (!empty) { if (!empty) {
OPM_WriteLn(); OPM_WriteLn();
} }
} else if ((obj->typ->form == 11 && obj->typ->BaseTyp->comp == 4)) {
empty = 1;
OPC_DeclareTProcs(obj->typ->BaseTyp->link, &empty);
OPC_DefineTProcMacros(obj->typ->BaseTyp->link, &empty);
if (!empty) {
OPM_WriteLn();
}
} }
} }
} }
@ -1138,7 +1151,7 @@ static void OPC_GenHeaderMsg (void)
OPM_WriteString((CHAR*)"/* ", 4); OPM_WriteString((CHAR*)"/* ", 4);
OPM_WriteString((CHAR*)"voc", 4); OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' '); OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, 75); OPM_WriteString(Configuration_versionLong, 76);
OPM_Write(' '); OPM_Write(' ');
i = 0; i = 0;
while (i <= 31) { while (i <= 31) {
@ -1739,7 +1752,7 @@ static void OPC_CharacterLiteral (INT64 c)
if ((c == 92 || c == 39) || c == 63) { if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\'); OPM_Write('\\');
} }
OPM_Write((CHAR)c); OPM_Write(__CHR(c));
OPM_Write('\''); OPM_Write('\'');
} }
} }
@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
c = (INT16)s[__X(i, s__len)]; c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) { if (c < 32 || c > 126) {
OPM_Write('\\'); OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6))); OPM_Write(__CHR(48 + __ASHR(c, 6)));
c = __MASK(c, -64); c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3))); OPM_Write(__CHR(48 + __ASHR(c, 3)));
c = __MASK(c, -8); c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c)); OPM_Write(__CHR(48 + c));
} else { } else {
if ((c == 92 || c == 34) || c == 63) { if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\'); OPM_Write('\\');
} }
OPM_Write((CHAR)c); OPM_Write(__CHR(c));
} }
i += 1; i += 1;
} }
@ -1830,6 +1843,12 @@ void OPC_IntLiteral (INT64 n, INT32 size)
void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
{ {
INT64 d;
d = dim;
while (d > 0) {
array = array->BaseTyp;
d -= 1;
}
if (array->comp == 3) { if (array->comp == 3) {
OPC_CompleteIdent(obj); OPC_CompleteIdent(obj);
OPM_WriteString((CHAR*)"__len", 6); OPM_WriteString((CHAR*)"__len", 6);
@ -1837,10 +1856,6 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
OPM_WriteInt(dim); OPM_WriteInt(dim);
} }
} else { } else {
while (dim > 0) {
array = array->BaseTyp;
dim -= 1;
}
OPM_WriteInt(array->n); OPM_WriteInt(array->n);
} }
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPC__h #ifndef OPC__h
#define OPC__h #define OPC__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -19,6 +19,8 @@ typedef
CHAR OPM_FileName[32]; CHAR OPM_FileName[32];
static CHAR OPM_currentComment[256];
static BOOLEAN OPM_hasComment;
static CHAR OPM_SourceFileName[256]; static CHAR OPM_SourceFileName[256];
static CHAR OPM_GlobalModel[10]; static CHAR OPM_GlobalModel[10];
export CHAR OPM_Model[10]; export CHAR OPM_Model[10];
@ -27,7 +29,7 @@ export INT16 OPM_AddressSize;
static INT16 OPM_GlobalAlignment; static INT16 OPM_GlobalAlignment;
export INT16 OPM_Alignment; export INT16 OPM_Alignment;
export UINT32 OPM_GlobalOptions, OPM_Options; export UINT32 OPM_GlobalOptions, OPM_Options;
export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
export INT64 OPM_MaxIndex; export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr; export BOOLEAN OPM_noerr;
@ -59,6 +61,7 @@ static void OPM_FindInstallDir (void);
static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos); static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len); static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch); export void OPM_Get (CHAR *ch);
export void OPM_GetComment (CHAR *text, ADDRESS text__len);
export void OPM_Init (BOOLEAN *done); export void OPM_Init (BOOLEAN *done);
export void OPM_InitOptions (void); export void OPM_InitOptions (void);
export INT16 OPM_Integer (INT64 n); export INT16 OPM_Integer (INT64 n);
@ -82,6 +85,7 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len);
static void OPM_ShowLine (INT64 pos); static void OPM_ShowLine (INT64 pos);
export INT64 OPM_SignedMaximum (INT32 bytecount); export INT64 OPM_SignedMaximum (INT32 bytecount);
export INT64 OPM_SignedMinimum (INT32 bytecount); export INT64 OPM_SignedMinimum (INT32 bytecount);
export void OPM_StoreComment (CHAR *text, ADDRESS text__len);
export void OPM_SymRCh (CHAR *ch); export void OPM_SymRCh (CHAR *ch);
export INT32 OPM_SymRInt (void); export INT32 OPM_SymRInt (void);
export INT64 OPM_SymRInt64 (void); export INT64 OPM_SymRInt64 (void);
@ -157,6 +161,36 @@ void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
__DEL(modname); __DEL(modname);
} }
void OPM_StoreComment (CHAR *text, ADDRESS text__len)
{
INT16 i;
__DUP(text, text__len, CHAR);
i = 0;
while ((i < 255 && text[__X(i, text__len)] != 0x00)) {
OPM_currentComment[__X(i, 256)] = text[__X(i, text__len)];
i += 1;
}
OPM_currentComment[__X(i, 256)] = 0x00;
OPM_hasComment = 1;
__DEL(text);
}
void OPM_GetComment (CHAR *text, ADDRESS text__len)
{
INT16 i;
if (OPM_hasComment) {
i = 0;
while ((((i < text__len && i < 256)) && OPM_currentComment[__X(i, 256)] != 0x00)) {
text[__X(i, text__len)] = OPM_currentComment[__X(i, 256)];
i += 1;
}
text[__X(i, text__len)] = 0x00;
OPM_hasComment = 0;
} else {
text[0] = 0x00;
}
}
INT64 OPM_SignedMaximum (INT32 bytecount) INT64 OPM_SignedMaximum (INT32 bytecount)
{ {
INT64 result; INT64 result;
@ -272,7 +306,7 @@ BOOLEAN OPM_OpenPar (void)
if (Modules_ArgCount == 1) { if (Modules_ArgCount == 1) {
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20); OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
OPM_LogWStr(Configuration_versionLong, 75); OPM_LogWStr(Configuration_versionLong, 76);
OPM_LogW('.'); OPM_LogW('.');
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52); OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52);
@ -338,7 +372,7 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
@ -410,21 +444,25 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
case 'C': case 'C':
OPM_ShortintSize = 2; OPM_ShortintSize = 2;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 4;
break; break;
case 'V': case 'V':
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 8;
break; break;
default: default:
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
} }
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024); __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
@ -606,7 +644,7 @@ static void OPM_ShowLine (INT64 pos)
if (pos >= (INT64)OPM_ErrorLineLimitPos) { if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1; pos = OPM_ErrorLineLimitPos - 1;
} }
i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos); i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768);
while (i > 0) { while (i > 0) {
OPM_LogW(' '); OPM_LogW(' ');
i -= 1; i -= 1;
@ -759,7 +797,7 @@ void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0); Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
if (tag != 0xf7 || ver != 0x83) { if (tag != 0xf7 || ver != 0x84) {
if (!__IN(4, OPM_Options, 32)) { if (!__IN(4, OPM_Options, 32)) {
OPM_err(-306); OPM_err(-306);
} }
@ -830,7 +868,7 @@ void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
if (OPM_newSFile != NIL) { if (OPM_newSFile != NIL) {
Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0); Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x83); Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
} else { } else {
OPM_err(153); OPM_err(153);
} }
@ -865,17 +903,17 @@ void OPM_WriteHex (INT64 i)
{ {
CHAR s[3]; CHAR s[3];
INT32 digit; INT32 digit;
digit = __ASHR((INT32)i, 4); digit = __ASHR(__SHORT(i, 2147483648LL), 4);
if (digit < 10) { if (digit < 10) {
s[0] = (CHAR)(48 + digit); s[0] = __CHR(48 + digit);
} else { } else {
s[0] = (CHAR)(87 + digit); s[0] = __CHR(87 + digit);
} }
digit = __MASK((INT32)i, -16); digit = __MASK(__SHORT(i, 2147483648LL), -16);
if (digit < 10) { if (digit < 10) {
s[1] = (CHAR)(48 + digit); s[1] = __CHR(48 + digit);
} else { } else {
s[1] = (CHAR)(87 + digit); s[1] = __CHR(87 + digit);
} }
s[2] = 0x00; s[2] = 0x00;
OPM_WriteString(s, 3); OPM_WriteString(s, 3);
@ -897,11 +935,11 @@ void OPM_WriteInt (INT64 i)
__MOVE("LL", s, 3); __MOVE("LL", s, 3);
k = 2; k = 2;
} }
s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10); i1 = __DIV(i1, 10);
k += 1; k += 1;
while (i1 > 0) { while (i1 > 0) {
s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10); i1 = __DIV(i1, 10);
k += 1; k += 1;
} }
@ -924,13 +962,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
CHAR s[32]; CHAR s[32];
CHAR ch; CHAR ch;
INT16 i; INT16 i;
if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) { if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == (__SHORT(__ENTIER(r), 2147483648LL)))) {
if (suffx == 'f') { if (suffx == 'f') {
OPM_WriteString((CHAR*)"(REAL)", 7); OPM_WriteString((CHAR*)"(REAL)", 7);
} else { } else {
OPM_WriteString((CHAR*)"(LONGREAL)", 11); OPM_WriteString((CHAR*)"(LONGREAL)", 11);
} }
OPM_WriteInt((INT32)__ENTIER(r)); OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL));
} else { } else {
Texts_OpenWriter(&W, Texts_Writer__typ); Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') { if (suffx == 'f') {
@ -1139,5 +1177,7 @@ export void *OPM__init(void)
OPM_MinReal = -OPM_MaxReal; OPM_MinReal = -OPM_MaxReal;
OPM_MinLReal = -OPM_MaxLReal; OPM_MinLReal = -OPM_MaxLReal;
OPM_FindInstallDir(); OPM_FindInstallDir();
OPM_hasComment = 0;
OPM_currentComment[0] = 0x00;
__ENDMOD; __ENDMOD;
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPM__h #ifndef OPM__h
#define OPM__h #define OPM__h
@ -9,7 +9,7 @@
import CHAR OPM_Model[10]; import CHAR OPM_Model[10];
import INT16 OPM_AddressSize, OPM_Alignment; import INT16 OPM_AddressSize, OPM_Alignment;
import UINT32 OPM_GlobalOptions, OPM_Options; import UINT32 OPM_GlobalOptions, OPM_Options;
import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
import INT64 OPM_MaxIndex; import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr; import BOOLEAN OPM_noerr;
@ -30,6 +30,7 @@ import void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
import void OPM_FPrintReal (INT32 *fp, REAL val); import void OPM_FPrintReal (INT32 *fp, REAL val);
import void OPM_FPrintSet (INT32 *fp, UINT64 val); import void OPM_FPrintSet (INT32 *fp, UINT64 val);
import void OPM_Get (CHAR *ch); import void OPM_Get (CHAR *ch);
import void OPM_GetComment (CHAR *text, ADDRESS text__len);
import void OPM_Init (BOOLEAN *done); import void OPM_Init (BOOLEAN *done);
import void OPM_InitOptions (void); import void OPM_InitOptions (void);
import INT16 OPM_Integer (INT64 n); import INT16 OPM_Integer (INT64 n);
@ -48,6 +49,7 @@ import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void); import void OPM_RegisterNewSym (void);
import INT64 OPM_SignedMaximum (INT32 bytecount); import INT64 OPM_SignedMaximum (INT32 bytecount);
import INT64 OPM_SignedMinimum (INT32 bytecount); import INT64 OPM_SignedMinimum (INT32 bytecount);
import void OPM_StoreComment (CHAR *text, ADDRESS text__len);
import void OPM_SymRCh (CHAR *ch); import void OPM_SymRCh (CHAR *ch);
import INT32 OPM_SymRInt (void); import INT32 OPM_SymRInt (void);
import INT64 OPM_SymRInt64 (void); import INT64 OPM_SymRInt64 (void);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -634,7 +634,7 @@ static void OPP_StandProcCall (OPT_Node *x)
OPT_Node y = NIL; OPT_Node y = NIL;
INT8 m; INT8 m;
INT16 n; INT16 n;
m = (INT8)((INT16)(*x)->obj->adr); m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128);
n = 0; n = 0;
if (OPP_sym == 30) { if (OPP_sym == 30) {
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
@ -943,7 +943,7 @@ static void GetCode__19 (void)
(*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)]; (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
n += 1; n += 1;
} }
(*ext)[0] = (CHAR)n; (*ext)[0] = __CHR(n);
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
} else { } else {
for (;;) { for (;;) {
@ -956,14 +956,14 @@ static void GetCode__19 (void)
n = 1; n = 1;
} }
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
(*ext)[__X(n, 256)] = (CHAR)c; (*ext)[__X(n, 256)] = __CHR(c);
} }
if (OPP_sym == 19) { if (OPP_sym == 19) {
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
} else if (OPP_sym == 35) { } else if (OPP_sym == 35) {
OPP_err(19); OPP_err(19);
} else { } else {
(*ext)[0] = (CHAR)n; (*ext)[0] = __CHR(n);
break; break;
} }
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPP__h #ifndef OPP__h
#define OPP__h #define OPP__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym)
OPS_err(241); OPS_err(241);
break; break;
} }
OPS_str[i] = OPS_ch; OPS_str[__X(i, 256)] = OPS_ch;
i += 1; i += 1;
} }
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
OPS_str[i] = 0x00; OPS_str[__X(i, 256)] = 0x00;
OPS_intval = i + 1; OPS_intval = i + 1;
if (OPS_intval == 2) { if (OPS_intval == 2) {
*sym = 35; *sym = 35;
@ -76,7 +76,7 @@ static void OPS_Identifier (INT8 *sym)
INT16 i; INT16 i;
i = 0; i = 0;
do { do {
OPS_name[i] = OPS_ch; OPS_name[__X(i, 256)] = OPS_ch;
i += 1; i += 1;
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
} while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256)); } while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256));
@ -84,7 +84,7 @@ static void OPS_Identifier (INT8 *sym)
OPS_err(240); OPS_err(240);
i -= 1; i -= 1;
} }
OPS_name[i] = 0x00; OPS_name[__X(i, 256)] = 0x00;
*sym = 38; *sym = 38;
} }
@ -143,7 +143,7 @@ static void OPS_Number (void)
if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) { if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) {
if (m > 0 || OPS_ch != '0') { if (m > 0 || OPS_ch != '0') {
if (n < 24) { if (n < 24) {
dig[n] = OPS_ch; dig[__X(n, 24)] = OPS_ch;
n += 1; n += 1;
} }
m += 1; m += 1;
@ -173,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1; OPS_numtyp = 1;
if (n <= 2) { if (n <= 2) {
while (i < n) { while (i < n) {
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1);
i += 1; i += 1;
} }
} else { } else {
@ -187,7 +187,7 @@ static void OPS_Number (void)
OPS_intval = -1; OPS_intval = -1;
} }
while (i < n) { while (i < n) {
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1);
i += 1; i += 1;
} }
} else { } else {
@ -196,7 +196,7 @@ static void OPS_Number (void)
} else { } else {
OPS_numtyp = 2; OPS_numtyp = 2;
while (i < n) { while (i < n) {
d = Ord__7(dig[i], 0); d = Ord__7(dig[__X(i, 24)], 0);
i += 1; i += 1;
if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) { if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
OPS_intval = OPS_intval * 10 + (INT64)d; OPS_intval = OPS_intval * 10 + (INT64)d;
@ -214,7 +214,7 @@ static void OPS_Number (void)
expCh = 'E'; expCh = 'E';
while (n > 0) { while (n > 0) {
n -= 1; n -= 1;
f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; f = (Ord__7(dig[__X(n, 24)], 0) + f) / (LONGREAL)(LONGREAL)10;
} }
if (OPS_ch == 'E' || OPS_ch == 'D') { if (OPS_ch == 'E' || OPS_ch == 'D') {
expCh = OPS_ch; expCh = OPS_ch;
@ -279,32 +279,74 @@ static void Comment__2 (void);
static void Comment__2 (void) static void Comment__2 (void)
{ {
BOOLEAN isExported;
CHAR commentText[256];
INT16 i, nestLevel;
CHAR prevCh, nextCh;
i = 0;
while (i <= 255) {
commentText[__X(i, 256)] = 0x00;
i += 1;
}
isExported = 0;
i = 0;
nestLevel = 1;
prevCh = 0x00;
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
for (;;) { if (OPS_ch == '*') {
for (;;) { isExported = 1;
while (OPS_ch == '(') { OPM_Get(&OPS_ch);
if (OPS_ch == ')') {
commentText[0] = 0x00;
OPM_StoreComment(commentText, 256);
OPM_Get(&OPS_ch);
return;
}
}
while ((nestLevel > 0 && OPS_ch != 0x00)) {
if ((prevCh == '(' && OPS_ch == '*')) {
nestLevel += 1;
prevCh = 0x00;
} else if ((prevCh == '*' && OPS_ch == ')')) {
nestLevel -= 1;
if (nestLevel == 0) {
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
if (OPS_ch == '*') { } else {
Comment__2(); prevCh = 0x00;
}
} else {
if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
} }
} }
if (OPS_ch == '*') { prevCh = OPS_ch;
OPM_Get(&OPS_ch); }
break; if (nestLevel > 0) {
}
if (OPS_ch == 0x00) {
break;
}
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
} }
if (OPS_ch == ')') { }
OPM_Get(&OPS_ch); if (OPS_ch == 0x00) {
break; OPS_err(5);
}
if ((((((isExported && nestLevel == 0)) && prevCh != 0x00)) && prevCh != '*')) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
} else {
OPM_LogWStr((CHAR*)"Truncating final comment character", 35);
OPM_LogWLn();
} }
if (OPS_ch == 0x00) { }
OPS_err(5); if (isExported) {
break; if (i >= 256) {
OPM_LogWStr((CHAR*)"Warning: commentText overflow", 30);
OPM_LogWLn();
i = 255;
} }
commentText[__X(i, 256)] = 0x00;
OPM_StoreComment(commentText, 256);
} }
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPS__h #ifndef OPS__h
#define OPS__h #define OPS__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -83,6 +83,7 @@ typedef
OPT_Const conval; OPT_Const conval;
INT32 adr, linkadr; INT32 adr, linkadr;
INT16 x; INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc; } OPT_ObjDesc;
typedef typedef
@ -173,6 +174,7 @@ static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par); static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ); static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj); static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len);
export OPT_Struct OPT_SetType (INT32 size); export OPT_Struct OPT_SetType (INT32 size);
export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir); export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
export INT32 OPT_SizeAlignment (INT32 size); export INT32 OPT_SizeAlignment (INT32 size);
@ -352,7 +354,7 @@ void OPT_TypSize (OPT_Struct typ)
} }
typ->size = offset; typ->size = offset;
typ->align = base; typ->align = base;
typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8); typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768);
} else if (c == 2) { } else if (c == 2) {
OPT_TypSize(typ->BaseTyp); OPT_TypSize(typ->BaseTyp);
typ->size = typ->n * typ->BaseTyp->size; typ->size = typ->n * typ->BaseTyp->size;
@ -388,6 +390,10 @@ OPT_Object OPT_NewObj (void)
{ {
OPT_Object obj = NIL; OPT_Object obj = NIL;
__NEW(obj, OPT_ObjDesc); __NEW(obj, OPT_ObjDesc);
obj->typ = NIL;
obj->conval = NIL;
obj->comment = NIL;
obj->name[0] = 0x00;
return obj; return obj;
} }
@ -554,6 +560,8 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
OPT_Object ob0 = NIL, ob1 = NIL; OPT_Object ob0 = NIL, ob1 = NIL;
BOOLEAN left; BOOLEAN left;
INT8 mnolev; INT8 mnolev;
CHAR commentText[256];
INT16 j;
ob0 = OPT_topScope; ob0 = OPT_topScope;
ob1 = ob0->right; ob1 = ob0->right;
left = 0; left = 0;
@ -585,6 +593,16 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
__COPY(name, ob1->name, 256); __COPY(name, ob1->name, 256);
mnolev = OPT_topScope->mnolev; mnolev = OPT_topScope->mnolev;
ob1->mnolev = mnolev; ob1->mnolev = mnolev;
OPM_GetComment((void*)commentText, 256);
if (commentText[0] != 0x00) {
ob1->comment = __NEWARR(NIL, 1, 1, 1, 0, 256);
j = 0;
while ((j < 255 && commentText[__X(j, 256)] != 0x00)) {
(*ob1->comment)[__X(j, 256)] = commentText[__X(j, 256)];
j += 1;
}
(*ob1->comment)[__X(j, 256)] = 0x00;
}
break; break;
} }
} }
@ -1103,6 +1121,13 @@ static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
tag = OPM_SymRInt(); tag = OPM_SymRInt();
last = NIL; last = NIL;
while (tag != 18) { while (tag != 18) {
if (tag < 0 || tag > 100) {
OPM_LogWStr((CHAR*)"ERROR: Invalid tag value in InSign: ", 37);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return;
}
new = OPT_NewObj(); new = OPT_NewObj();
new->mnolev = -mno; new->mnolev = -mno;
if (last == NIL) { if (last == NIL) {
@ -1251,7 +1276,7 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0; obj->vis = 0;
tag = OPM_SymRInt(); tag = OPM_SymRInt();
if (tag == 35) { if (tag == 35) {
(*typ)->sysflag = (INT16)OPM_SymRInt(); (*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768);
tag = OPM_SymRInt(); tag = OPM_SymRInt();
} }
switch (tag) { switch (tag) {
@ -1381,7 +1406,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
INT32 tag; INT32 tag;
OPT_ConstExt ext = NIL; OPT_ConstExt ext = NIL;
OPS_Name commentText;
BOOLEAN hasComment;
INT16 j;
INT32 len;
tag = OPT_impCtxt.nextTag; tag = OPT_impCtxt.nextTag;
hasComment = 0;
while (tag == 41) {
len = OPM_SymRInt();
if (len < 0) {
len = 0;
}
if (len > 255) {
len = 255;
}
i = 0;
while (i < len) {
OPM_SymRCh(&commentText[__X(i, 256)]);
i += 1;
}
commentText[__X(i, 256)] = 0x00;
hasComment = 1;
tag = OPM_SymRInt();
}
OPT_impCtxt.nextTag = tag;
if (tag < 0 || tag > 50) {
OPM_LogWStr((CHAR*)"ERROR: Invalid tag in InObj: ", 30);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return NIL;
}
if (tag == 19) { if (tag == 19) {
OPT_InStruct(&typ); OPT_InStruct(&typ);
obj = typ->strobj; obj = typ->strobj;
@ -1397,7 +1452,7 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->conval = OPT_NewConst(); obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval); OPT_InConstant(tag, obj->conval);
obj->typ = OPT_InTyp(tag); obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) { } else if ((tag >= 31 && tag <= 33)) {
obj->conval = OPT_NewConst(); obj->conval = OPT_NewConst();
obj->conval->intval = -1; obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link); OPT_InSign(mno, &obj->typ, &obj->link);
@ -1412,8 +1467,8 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->mode = 9; obj->mode = 9;
ext = OPT_NewExt(); ext = OPT_NewExt();
obj->conval->ext = ext; obj->conval->ext = ext;
s = (INT16)OPM_SymRInt(); s = __SHORTF(OPM_SymRInt(), 32768);
(*ext)[0] = (CHAR)s; (*ext)[0] = __CHR(s);
i = 1; i = 1;
while (i <= s) { while (i <= s) {
OPM_SymRCh(&(*ext)[__X(i, 256)]); OPM_SymRCh(&(*ext)[__X(i, 256)]);
@ -1424,20 +1479,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32); OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
OPM_LogWNum(tag, 0); OPM_LogWNum(tag, 0);
OPM_LogWLn(); OPM_LogWLn();
OPM_err(155);
return NIL;
break; break;
} }
} else if (tag == 20) { } else if (tag == 20) {
obj->mode = 5; obj->mode = 5;
OPT_InStruct(&obj->typ); OPT_InStruct(&obj->typ);
} else { } else if (tag == 21 || tag == 22) {
obj->mode = 1; obj->mode = 1;
if (tag == 22) { if (tag == 22) {
obj->vis = 2; obj->vis = 2;
} }
OPT_InStruct(&obj->typ); OPT_InStruct(&obj->typ);
} else {
OPM_LogWStr((CHAR*)"ERROR: Unexpected tag in InObj: ", 33);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return NIL;
} }
OPT_InName((void*)obj->name, 256); OPT_InName((void*)obj->name, 256);
} }
if ((hasComment && obj != NIL)) {
obj->comment = __NEWARR(NIL, 1, 1, 1, 0, 256);
j = 0;
while ((((j < 255 && j < len)) && commentText[__X(j, 256)] != 0x00)) {
(*obj->comment)[__X(j, 256)] = commentText[__X(j, 256)];
j += 1;
}
(*obj->comment)[__X(j, 256)] = 0x00;
}
OPT_FPrintObj(obj); OPT_FPrintObj(obj);
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) { if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255); OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
@ -1752,7 +1824,7 @@ static void OPT_OutConstant (OPT_Object obj)
OPM_SymWInt(f); OPM_SymWInt(f);
switch (f) { switch (f) {
case 2: case 3: case 2: case 3:
OPM_SymWCh((CHAR)obj->conval->intval); OPM_SymWCh(__CHR(obj->conval->intval));
break; break;
case 4: case 4:
OPM_SymWInt(obj->conval->intval); OPM_SymWInt(obj->conval->intval);
@ -1780,13 +1852,40 @@ static void OPT_OutConstant (OPT_Object obj)
} }
} }
static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len)
{
INT16 i;
__DUP(text, text__len, CHAR);
i = 0;
while ((i < 255 && text[__X(i, text__len)] != 0x00)) {
OPM_SymWCh(text[__X(i, text__len)]);
i += 1;
}
OPM_SymWCh(0x00);
__DEL(text);
}
static void OPT_OutObj (OPT_Object obj) static void OPT_OutObj (OPT_Object obj)
{ {
INT16 i, j; INT16 i, j;
OPT_ConstExt ext = NIL; OPT_ConstExt ext = NIL;
INT16 k, l;
if (obj != NIL) { if (obj != NIL) {
OPT_OutObj(obj->left); OPT_OutObj(obj->left);
if (__IN(obj->mode, 0x06ea, 32)) { if (__IN(obj->mode, 0x06ea, 32)) {
if (obj->comment != NIL) {
OPM_SymWInt(41);
k = 0;
while ((k < 255 && (*obj->comment)[__X(k, 256)] != 0x00)) {
k += 1;
}
OPM_SymWInt(k);
l = 0;
while (l < k) {
OPM_SymWCh((*obj->comment)[__X(l, 256)]);
l += 1;
}
}
if (obj->history == 4) { if (obj->history == 4) {
OPT_FPrintErr(obj, 250); OPT_FPrintErr(obj, 250);
} else if (obj->vis != 0) { } else if (obj->vis != 0) {
@ -2026,7 +2125,7 @@ static void EnumPtrs(void (*P)(void*))
} }
__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 32), {0, -8}}; __TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 32), {0, -8}};
__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}}; __TDESC(OPT_ObjDesc, 1, 7) = {__TDFLDS("ObjDesc", 308), {0, 4, 8, 12, 284, 288, 304, -32}};
__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 56), {44, 48, 52, -16}}; __TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 56), {44, 48, 52, -16}};
__TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 28), {0, 4, 8, 16, 20, 24, -28}}; __TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 28), {0, 4, 8, 16, 20, 24, -28}};
__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76, __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76,

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPT__h #ifndef OPT__h
#define OPT__h #define OPT__h
@ -61,6 +61,7 @@ typedef
OPT_Const conval; OPT_Const conval;
INT32 adr, linkadr; INT32 adr, linkadr;
INT16 x; INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc; } OPT_ObjDesc;
typedef typedef

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -112,7 +112,7 @@ static void OPV_Stamp (OPS_Name s)
i += 2; i += 2;
k = 0; k = 0;
do { do {
n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48); n[__X(k, 10)] = __CHR((int)__MOD(j, 10) + 48);
j = __DIV(j, 10); j = __DIV(j, 10);
k += 1; k += 1;
} while (!(j == 0)); } while (!(j == 0));
@ -317,15 +317,27 @@ static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp
static void OPV_Len (OPT_Node n, INT64 dim) static void OPV_Len (OPT_Node n, INT64 dim)
{ {
INT64 d;
OPT_Struct array = NIL;
while ((n->class == 4 && n->typ->comp == 3)) { while ((n->class == 4 && n->typ->comp == 3)) {
dim += 1; dim += 1;
n = n->left; n = n->left;
} }
if ((n->class == 3 && n->typ->comp == 3)) { if ((n->class == 3 && n->typ->comp == 3)) {
OPV_design(n->left, 10); d = dim;
OPM_WriteString((CHAR*)"->len[", 7); array = n->typ;
OPM_WriteInt(dim); while (d > 0) {
OPM_Write(']'); array = array->BaseTyp;
d -= 1;
}
if (array->comp == 3) {
OPV_design(n->left, 10);
OPM_WriteString((CHAR*)"->len[", 7);
OPM_WriteInt(dim);
OPM_Write(']');
} else {
OPM_WriteInt(array->n);
}
} else { } else {
OPC_Len(n->obj, n->typ, dim); OPC_Len(n->obj, n->typ, dim);
} }
@ -370,6 +382,7 @@ static void OPV_SizeCast (OPT_Node n, INT32 to)
OPM_WriteInt(__ASHL(to, 3)); OPM_WriteInt(__ASHL(to, 3));
OPM_WriteString((CHAR*)")", 2); OPM_WriteString((CHAR*)")", 2);
} }
OPV_Entier(n, 9);
} }
} }
@ -381,7 +394,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec)
if (to == 7) { if (to == 7) {
if (from == 7) { if (from == 7) {
OPV_SizeCast(n, newtype->size); OPV_SizeCast(n, newtype->size);
OPV_Entier(n, 9);
} else { } else {
OPM_WriteString((CHAR*)"__SETOF(", 9); OPM_WriteString((CHAR*)"__SETOF(", 9);
OPV_Entier(n, -1); OPV_Entier(n, -1);
@ -391,7 +403,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec)
} }
} else if (to == 4) { } else if (to == 4) {
OPV_SizeCast(n, newtype->size); OPV_SizeCast(n, newtype->size);
OPV_Entier(n, 9);
} else if (to == 3) { } else if (to == 3) {
if (__IN(2, OPM_Options, 32)) { if (__IN(2, OPM_Options, 32)) {
OPM_WriteString((CHAR*)"__CHR", 6); OPM_WriteString((CHAR*)"__CHR", 6);
@ -1183,7 +1194,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
base = base->BaseTyp; base = base->BaseTyp;
} }
if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) {
OPC_Ident(base->strobj); OPC_Andent(base);
OPM_WriteString((CHAR*)"__typ", 6); OPM_WriteString((CHAR*)"__typ", 6);
} else if (base->form == 11) { } else if (base->form == 11) {
OPM_WriteString((CHAR*)"POINTER__typ", 13); OPM_WriteString((CHAR*)"POINTER__typ", 13);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPV__h #ifndef OPV__h
#define OPV__h #define OPV__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -80,7 +80,7 @@ void Out_String (CHAR *str, ADDRESS str__len)
error = Platform_Write(1, (ADDRESS)str, l); error = Platform_Write(1, (ADDRESS)str, l);
} else { } else {
__MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l); __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l);
Out_in += (INT16)l; Out_in += __SHORT(l, 32768);
} }
__DEL(str); __DEL(str);
} }
@ -98,11 +98,11 @@ void Out_Int (INT64 x, INT64 n)
if (x < 0) { if (x < 0) {
x = -x; x = -x;
} }
s[0] = (CHAR)(48 + __MOD(x, 10)); s[0] = __CHR(48 + __MOD(x, 10));
x = __DIV(x, 10); x = __DIV(x, 10);
i = 1; i = 1;
while (x != 0) { while (x != 0) {
s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10)); s[__X(i, 22)] = __CHR(48 + __MOD(x, 10));
x = __DIV(x, 10); x = __DIV(x, 10);
i += 1; i += 1;
} }
@ -138,9 +138,9 @@ void Out_Hex (INT64 x, INT64 n)
x = __ROTL(x, 4, 64); x = __ROTL(x, 4, 64);
n -= 1; n -= 1;
if (__MASK(x, -16) < 10) { if (__MASK(x, -16) < 10) {
Out_Char((CHAR)(__MASK(x, -16) + 48)); Out_Char(__CHR(__MASK(x, -16) + 48));
} else { } else {
Out_Char((CHAR)((__MASK(x, -16) - 10) + 65)); Out_Char(__CHR((__MASK(x, -16) - 10) + 65));
} }
} }
} }
@ -154,7 +154,7 @@ void Out_Ln (void)
static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i) static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i)
{ {
*i -= 1; *i -= 1;
s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48); s[__X(*i, s__len)] = __CHR(__MOD(n, 10) + 48);
} }
static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i) static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i)
@ -166,7 +166,7 @@ static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16
if (l > *i) { if (l > *i) {
l = *i; l = *i;
} }
*i -= (INT16)l; *i -= __SHORT(l, 32768);
j = 0; j = 0;
while (j < l) { while (j < l) {
s[__X(*i + j, s__len)] = t[__X(j, t__len)]; s[__X(*i + j, s__len)] = t[__X(j, t__len)];
@ -248,7 +248,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
if (nn) { if (nn) {
x = -x; x = -x;
} }
e = (INT16)__ASHR((e - 1023) * 77, 8); e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
if (e >= 0) { if (e >= 0) {
x = x / (LONGREAL)Out_Ten(e); x = x / (LONGREAL)Out_Ten(e);
} else { } else {

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Out__h #ifndef Out__h
#define Out__h #define Out__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -42,6 +42,8 @@ export BOOLEAN Platform_Inaccessible (INT16 e);
export BOOLEAN Platform_Interrupted (INT16 e); export BOOLEAN Platform_Interrupted (INT16 e);
export BOOLEAN Platform_IsConsole (INT32 h); export BOOLEAN Platform_IsConsole (INT32 h);
export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
export INT16 Platform_MaxNameLength (void);
export INT16 Platform_MaxPathLength (void);
export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
export BOOLEAN Platform_NoSuchDirectory (INT16 e); export BOOLEAN Platform_NoSuchDirectory (INT16 e);
export INT32 Platform_OSAllocate (INT32 size); export INT32 Platform_OSAllocate (INT32 size);
@ -79,6 +81,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS
#include <sys/types.h> #include <sys/types.h>
#include <time.h> #include <time.h>
#include <unistd.h> #include <unistd.h>
#include <limits.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#define Platform_EACCES() EACCES #define Platform_EACCES() EACCES
@ -94,6 +97,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS
#define Platform_EROFS() EROFS #define Platform_EROFS() EROFS
#define Platform_ETIMEDOUT() ETIMEDOUT #define Platform_ETIMEDOUT() ETIMEDOUT
#define Platform_EXDEV() EXDEV #define Platform_EXDEV() EXDEV
#define Platform_NAMEMAX() NAME_MAX
#define Platform_PATHMAX() PATH_MAX
#define Platform_allocate(size) (ADDRESS)((void*)malloc((size_t)size)) #define Platform_allocate(size) (ADDRESS)((void*)malloc((size_t)size))
#define Platform_chdir(n, n__len) chdir((char*)n) #define Platform_chdir(n, n__len) chdir((char*)n)
#define Platform_closefile(fd) close(fd) #define Platform_closefile(fd) close(fd)
@ -178,6 +183,16 @@ BOOLEAN Platform_Interrupted (INT16 e)
return e == Platform_EINTR(); return e == Platform_EINTR();
} }
INT16 Platform_MaxNameLength (void)
{
return Platform_NAMEMAX();
}
INT16 Platform_MaxPathLength (void)
{
return Platform_PATHMAX();
}
INT32 Platform_OSAllocate (INT32 size) INT32 Platform_OSAllocate (INT32 size)
{ {
return Platform_allocate(size); return Platform_allocate(size);
@ -189,13 +204,13 @@ void Platform_OSFree (INT32 address)
} }
typedef typedef
CHAR (*EnvPtr__78)[1024]; CHAR (*EnvPtr__83)[1024];
BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len) BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{ {
EnvPtr__78 p = NIL; EnvPtr__83 p = NIL;
__DUP(var, var__len, CHAR); __DUP(var, var__len, CHAR);
p = (EnvPtr__78)(ADDRESS)Platform_getenv(var, var__len); p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
if (p != NIL) { if (p != NIL) {
__COPY(*p, val, val__len); __COPY(*p, val, val__len);
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Platform__h #ifndef Platform__h
#define Platform__h #define Platform__h
@ -40,6 +40,8 @@ import BOOLEAN Platform_Inaccessible (INT16 e);
import BOOLEAN Platform_Interrupted (INT16 e); import BOOLEAN Platform_Interrupted (INT16 e);
import BOOLEAN Platform_IsConsole (INT32 h); import BOOLEAN Platform_IsConsole (INT32 h);
import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
import INT16 Platform_MaxNameLength (void);
import INT16 Platform_MaxPathLength (void);
import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
import BOOLEAN Platform_NoSuchDirectory (INT16 e); import BOOLEAN Platform_NoSuchDirectory (INT16 e);
import INT32 Platform_OSAllocate (INT32 size); import INT32 Platform_OSAllocate (INT32 size);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -67,9 +67,9 @@ void Reals_SetExpo (REAL *x, INT16 ex)
{ {
CHAR c; CHAR c;
__GET((ADDRESS)x + 3, c, CHAR); __GET((ADDRESS)x + 3, c, CHAR);
__PUT((ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); __PUT((ADDRESS)x + 3, __CHR(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
__GET((ADDRESS)x + 2, c, CHAR); __GET((ADDRESS)x + 2, c, CHAR);
__PUT((ADDRESS)x + 2, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); __PUT((ADDRESS)x + 2, __CHR(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
} }
INT16 Reals_ExpoL (LONGREAL x) INT16 Reals_ExpoL (LONGREAL x)
@ -87,21 +87,21 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len)
} }
k = 0; k = 0;
if (n > 9) { if (n > 9) {
i = (INT32)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000); i = __SHORT(__ENTIER(x / (LONGREAL)(LONGREAL)1000000000), 2147483648LL);
j = (INT32)__ENTIER(x - i * (LONGREAL)1000000000); j = __SHORT(__ENTIER(x - i * (LONGREAL)1000000000), 2147483648LL);
if (j < 0) { if (j < 0) {
j = 0; j = 0;
} }
while (k < 9) { while (k < 9) {
d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48); d[__X(k, d__len)] = __CHR((int)__MOD(j, 10) + 48);
j = __DIV(j, 10); j = __DIV(j, 10);
k += 1; k += 1;
} }
} else { } else {
i = (INT32)__ENTIER(x); i = __SHORT(__ENTIER(x), 2147483648LL);
} }
while (k < n) { while (k < n) {
d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48); d[__X(k, d__len)] = __CHR((int)__MOD(i, 10) + 48);
i = __DIV(i, 10); i = __DIV(i, 10);
k += 1; k += 1;
} }
@ -115,9 +115,9 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
static CHAR Reals_ToHex (INT16 i) static CHAR Reals_ToHex (INT16 i)
{ {
if (i < 10) { if (i < 10) {
return (CHAR)(i + 48); return __CHR(i + 48);
} else { } else {
return (CHAR)(i + 55); return __CHR(i + 55);
} }
__RETCHK; __RETCHK;
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Reals__h #ifndef Reals__h
#define Reals__h #define Reals__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -6,6 +6,7 @@
#define SET UINT32 #define SET UINT32
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Reals.h"
@ -19,6 +20,8 @@ export INT16 Strings_Length (CHAR *s, ADDRESS s__len);
export BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); export BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len);
export INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); export INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos);
export void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); export void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
export void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r);
export void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r);
INT16 Strings_Length (CHAR *s, ADDRESS s__len) INT16 Strings_Length (CHAR *s, ADDRESS s__len)
@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len)
} }
if (i <= 32767) { if (i <= 32767) {
__DEL(s); __DEL(s);
return (INT16)i; return __SHORT(i, 32768);
} else { } else {
__DEL(s); __DEL(s);
return 32767; return 32767;
@ -123,7 +126,7 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA
INT16 len, destLen, i; INT16 len, destLen, i;
__DUP(source, source__len, CHAR); __DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len); len = Strings_Length(source, source__len);
destLen = (INT16)dest__len - 1; destLen = __SHORT(dest__len, 32768) - 1;
if (pos < 0) { if (pos < 0) {
pos = 0; pos = 0;
} }
@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS
return __retval; return __retval;
} }
void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r)
{
INT16 p, e;
REAL y, g;
BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
if (s[__X(p, s__len)] == '-') {
neg = 1;
p += 1;
} else {
neg = 0;
}
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
y = (REAL)0;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
y = y * (REAL)10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (s[__X(p, s__len)] == '.') {
p += 1;
g = (REAL)1;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
g = g / (REAL)(REAL)10;
y = y + g * ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
}
if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') {
p += 1;
e = 0;
if (s[__X(p, s__len)] == '-') {
negE = 1;
p += 1;
} else {
negE = 0;
}
while (s[__X(p, s__len)] == '0') {
p += 1;
}
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
e = e * 10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (negE) {
y = y / (REAL)Reals_Ten(e);
} else {
y = y * Reals_Ten(e);
}
}
if (neg) {
y = -y;
}
*r = y;
__DEL(s);
}
void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r)
{
INT16 p, e;
LONGREAL y, g;
BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
if (s[__X(p, s__len)] == '-') {
neg = 1;
p += 1;
} else {
neg = 0;
}
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
y = (LONGREAL)0;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
y = y * (LONGREAL)10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (s[__X(p, s__len)] == '.') {
p += 1;
g = (LONGREAL)1;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
g = g / (LONGREAL)(LONGREAL)10;
y = y + g * ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
}
if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') {
p += 1;
e = 0;
if (s[__X(p, s__len)] == '-') {
negE = 1;
p += 1;
} else {
negE = 0;
}
while (s[__X(p, s__len)] == '0') {
p += 1;
}
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
e = e * 10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (negE) {
y = y / (LONGREAL)Reals_Ten(e);
} else {
y = y * Reals_Ten(e);
}
}
if (neg) {
y = -y;
}
*r = y;
__DEL(s);
}
export void *Strings__init(void) export void *Strings__init(void)
{ {
__DEFMOD; __DEFMOD;
__MODULE_IMPORT(Reals);
__REGMOD("Strings", 0); __REGMOD("Strings", 0);
/* BEGIN */ /* BEGIN */
__ENDMOD; __ENDMOD;

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Strings__h #ifndef Strings__h
#define Strings__h #define Strings__h
@ -17,6 +17,8 @@ import INT16 Strings_Length (CHAR *s, ADDRESS s__len);
import BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); import BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len);
import INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); import INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos);
import void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); import void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
import void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r);
import void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r);
import void *Strings__init(void); import void *Strings__init(void);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -8,7 +8,6 @@
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Files.h" #include "Files.h"
#include "Modules.h" #include "Modules.h"
#include "Out.h"
#include "Reals.h" #include "Reals.h"
typedef typedef
@ -813,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ)
if ('9' < ch) { if ('9' < ch) {
if (('A' <= ch && ch <= 'F')) { if (('A' <= ch && ch <= 'F')) {
hex = 1; hex = 1;
ch = (CHAR)((INT16)ch - 7); ch = __CHR((INT16)ch - 7);
} else if (('a' <= ch && ch <= 'f')) { } else if (('a' <= ch && ch <= 'f')) {
hex = 1; hex = 1;
ch = (CHAR)((INT16)ch - 39); ch = __CHR((INT16)ch - 39);
} else { } else {
break; break;
} }
@ -1058,7 +1057,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
x0 = x; x0 = x;
} }
do { do {
a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48); a[__X(i, 24)] = __CHR(__MOD(x0, 10) + 48);
x0 = __DIV(x0, 10); x0 = __DIV(x0, 10);
i += 1; i += 1;
} while (!(x0 == 0)); } while (!(x0 == 0));
@ -1085,9 +1084,9 @@ void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x)
do { do {
y = __MASK(x, -16); y = __MASK(x, -16);
if (y < 10) { if (y < 10) {
a[__X(i, 20)] = (CHAR)(y + 48); a[__X(i, 20)] = __CHR(y + 48);
} else { } else {
a[__X(i, 20)] = (CHAR)(y + 55); a[__X(i, 20)] = __CHR(y + 55);
} }
x = __ASHR(x, 4); x = __ASHR(x, 4);
i += 1; i += 1;
@ -1163,8 +1162,8 @@ void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n)
} else { } else {
Texts_Write(&*W, W__typ, '+'); Texts_Write(&*W, W__typ, '+');
} }
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
} }
} }
@ -1314,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
} else { } else {
Texts_Write(&*W, W__typ, ' '); Texts_Write(&*W, W__typ, ' ');
} }
e = (INT16)__ASHR((e - 1023) * 77, 8); e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
if (e >= 0) { if (e >= 0) {
x = x / (LONGREAL)Reals_TenL(e); x = x / (LONGREAL)Reals_TenL(e);
} else { } else {
@ -1345,10 +1344,10 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
} else { } else {
Texts_Write(&*W, W__typ, '+'); Texts_Write(&*W, W__typ, '+');
} }
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); Texts_Write(&*W, W__typ, __CHR(__DIV(e, 100) + 48));
e = (int)__MOD(e, 100); e = (int)__MOD(e, 100);
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
} }
} }
@ -1375,8 +1374,8 @@ static void WritePair__44 (CHAR ch, INT32 x);
static void WritePair__44 (CHAR ch, INT32 x) static void WritePair__44 (CHAR ch, INT32 x)
{ {
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch); Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch);
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48)); Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR(__DIV(x, 10) + 48));
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)((int)__MOD(x, 10) + 48)); Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR((int)__MOD(x, 10) + 48));
} }
void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d) void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d)
@ -1810,7 +1809,6 @@ export void *Texts__init(void)
__DEFMOD; __DEFMOD;
__MODULE_IMPORT(Files); __MODULE_IMPORT(Files);
__MODULE_IMPORT(Modules); __MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Reals); __MODULE_IMPORT(Reals);
__REGMOD("Texts", EnumPtrs); __REGMOD("Texts", EnumPtrs);
__INITYP(Texts_FontDesc, Texts_FontDesc, 0); __INITYP(Texts_FontDesc, Texts_FontDesc, 0);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Texts__h #ifndef Texts__h
#define Texts__h #define Texts__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -34,6 +34,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len);
export void VT100_HVP (INT16 n, INT16 m); export void VT100_HVP (INT16 n, INT16 m);
export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
export void VT100_RCP (void); export void VT100_RCP (void);
export void VT100_Reset (void);
static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end); static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end);
export void VT100_SCP (void); export void VT100_SCP (void);
export void VT100_SD (INT16 n); export void VT100_SD (INT16 n);
@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
} }
e = s; e = s;
do { do {
b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48); b[__X(e, 21)] = __CHR((int)__MOD(int_, 10) + 48);
int_ = __DIV(int_, 10); int_ = __DIV(int_, 10);
e += 1; e += 1;
} while (!(int_ == 0)); } while (!(int_ == 0));
@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
__DEL(letter); __DEL(letter);
} }
void VT100_Reset (void)
{
CHAR cmd[6];
__COPY("\033", cmd, 6);
Strings_Append((CHAR*)"c", 2, (void*)cmd, 6);
Out_String(cmd, 6);
Out_Ln();
}
void VT100_CUU (INT16 n) void VT100_CUU (INT16 n)
{ {
VT100_EscSeq(n, (CHAR*)"A", 2); VT100_EscSeq(n, (CHAR*)"A", 2);
@ -256,6 +266,7 @@ export void *VT100__init(void)
__REGCMD("DECTCEMh", VT100_DECTCEMh); __REGCMD("DECTCEMh", VT100_DECTCEMh);
__REGCMD("DECTCEMl", VT100_DECTCEMl); __REGCMD("DECTCEMl", VT100_DECTCEMl);
__REGCMD("RCP", VT100_RCP); __REGCMD("RCP", VT100_RCP);
__REGCMD("Reset", VT100_Reset);
__REGCMD("SCP", VT100_SCP); __REGCMD("SCP", VT100_SCP);
/* BEGIN */ /* BEGIN */
__COPY("\033", VT100_CSI, 5); __COPY("\033", VT100_CSI, 5);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef VT100__h #ifndef VT100__h
#define VT100__h #define VT100__h
@ -25,6 +25,7 @@ import void VT100_EL (INT16 n);
import void VT100_HVP (INT16 n, INT16 m); import void VT100_HVP (INT16 n, INT16 m);
import void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); import void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
import void VT100_RCP (void); import void VT100_RCP (void);
import void VT100_Reset (void);
import void VT100_SCP (void); import void VT100_SCP (void);
import void VT100_SD (INT16 n); import void VT100_SD (INT16 n);
import void VT100_SGR (INT16 n); import void VT100_SGR (INT16 n);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -7,18 +7,22 @@
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Configuration.h" #include "Configuration.h"
#include "Heap.h"
#include "Modules.h" #include "Modules.h"
#include "OPM.h" #include "OPM.h"
#include "Out.h" #include "Out.h"
#include "Platform.h" #include "Platform.h"
#include "Strings.h" #include "Strings.h"
typedef
CHAR extTools_CommandString[4096];
static CHAR extTools_CFLAGS[1023];
static extTools_CommandString extTools_CFLAGS;
export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len); export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len);
static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len); static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len);
export void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len); export void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len);
static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len); static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len);
@ -26,14 +30,17 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES
static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len) static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len)
{ {
INT16 r, status, exitcode; INT16 r, status, exitcode;
extTools_CommandString fullcmd;
__DUP(title, title__len, CHAR); __DUP(title, title__len, CHAR);
__DUP(cmd, cmd__len, CHAR); __DUP(cmd, cmd__len, CHAR);
if (__IN(18, OPM_Options, 32)) { if (__IN(18, OPM_Options, 32)) {
Out_String(title, title__len); Out_String((CHAR*)" ", 3);
Out_String(cmd, cmd__len); Out_String(cmd, cmd__len);
Out_Ln(); Out_Ln();
} }
r = Platform_System(cmd, cmd__len); __COPY(cmd, fullcmd, 4096);
Heap_GC(0);
r = Platform_System(fullcmd, 4096);
status = __MASK(r, -128); status = __MASK(r, -128);
exitcode = __ASHR(r, 8); exitcode = __ASHR(r, 8);
if (exitcode > 127) { if (exitcode > 127) {
@ -63,50 +70,55 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES
__DEL(cmd); __DEL(cmd);
} }
static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len) static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len)
{ {
__COPY("gcc -g", s, s__len); __DUP(additionalopts, additionalopts__len, CHAR);
__COPY("gcc -fPIC -g -Wno-stringop-overflow", s, s__len);
Strings_Append((CHAR*)" -I \"", 6, (void*)s, s__len); Strings_Append((CHAR*)" -I \"", 6, (void*)s, s__len);
Strings_Append(OPM_ResourceDir, 1024, (void*)s, s__len); Strings_Append(OPM_ResourceDir, 1024, (void*)s, s__len);
Strings_Append((CHAR*)"/include\" ", 11, (void*)s, s__len); Strings_Append((CHAR*)"/include\" ", 11, (void*)s, s__len);
Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 1023); Strings_Append(additionalopts, additionalopts__len, (void*)s, s__len);
Strings_Append(extTools_CFLAGS, 1023, (void*)s, s__len);
Strings_Append((CHAR*)" ", 2, (void*)s, s__len); Strings_Append((CHAR*)" ", 2, (void*)s, s__len);
Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 4096);
Strings_Append(extTools_CFLAGS, 4096, (void*)s, s__len);
Strings_Append((CHAR*)" ", 2, (void*)s, s__len);
__DEL(additionalopts);
} }
void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len) void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len)
{ {
CHAR cmd[1023]; extTools_CommandString cmd;
__DUP(moduleName, moduleName__len, CHAR); __DUP(moduleName, moduleName__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 1023); extTools_InitialiseCompilerCommand((void*)cmd, 4096, (CHAR*)"", 1);
Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 1023); Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c", 3, (void*)cmd, 1023); Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096);
extTools_execute((CHAR*)"C compile: ", 12, cmd, 1023); extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096);
__DEL(moduleName); __DEL(moduleName);
} }
void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len) void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len)
{ {
CHAR cmd[1023]; extTools_CommandString cmd;
__DUP(additionalopts, additionalopts__len, CHAR); __DUP(additionalopts, additionalopts__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 1023); extTools_InitialiseCompilerCommand((void*)cmd, 4096, additionalopts, additionalopts__len);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c ", 4, (void*)cmd, 1023); Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096);
Strings_Append(additionalopts, additionalopts__len, (void*)cmd, 1023);
if (statically) { if (statically) {
Strings_Append((CHAR*)" -static", 9, (void*)cmd, 1023); Strings_Append((CHAR*)" -static", 9, (void*)cmd, 4096);
} }
Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 1023); Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 1023); if (!statically || 1) {
Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 1023); Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 4096);
Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 1023); Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 4096);
Strings_Append((CHAR*)" -l voc", 8, (void*)cmd, 1023); Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 4096);
Strings_Append((CHAR*)"-O", 3, (void*)cmd, 1023); Strings_Append((CHAR*)" -lvoc", 7, (void*)cmd, 4096);
Strings_Append(OPM_Model, 10, (void*)cmd, 1023); Strings_Append((CHAR*)"-O", 3, (void*)cmd, 4096);
Strings_Append((CHAR*)"", 1, (void*)cmd, 1023); Strings_Append(OPM_Model, 10, (void*)cmd, 4096);
extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 1023); Strings_Append((CHAR*)"", 1, (void*)cmd, 4096);
}
extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096);
__DEL(additionalopts); __DEL(additionalopts);
} }
@ -115,6 +127,7 @@ export void *extTools__init(void)
{ {
__DEFMOD; __DEFMOD;
__MODULE_IMPORT(Configuration); __MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Modules); __MODULE_IMPORT(Modules);
__MODULE_IMPORT(OPM); __MODULE_IMPORT(OPM);
__MODULE_IMPORT(Out); __MODULE_IMPORT(Out);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef extTools__h #ifndef extTools__h
#define extTools__h #define extTools__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -89,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp; OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp; OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp; OPT_lintobj->typ = OPT_linttyp;
switch (OPM_LongintSize) { switch (OPM_SetSize) {
case 4: case 4:
OPT_settyp = OPT_set32typ; OPT_settyp = OPT_set32typ;
break; break;

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -8,7 +8,7 @@
#include "SYSTEM.h" #include "SYSTEM.h"
export CHAR Configuration_versionLong[75]; export CHAR Configuration_versionLong[76];
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD; __DEFMOD;
__REGMOD("Configuration", 0); __REGMOD("Configuration", 0);
/* BEGIN */ /* BEGIN */
__MOVE("2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); __MOVE("2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76);
__ENDMOD; __ENDMOD;
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Configuration__h #ifndef Configuration__h
#define Configuration__h #define Configuration__h
@ -6,7 +6,7 @@
#include "SYSTEM.h" #include "SYSTEM.h"
import CHAR Configuration_versionLong[75]; import CHAR Configuration_versionLong[76];
import void *Configuration__init(void); import void *Configuration__init(void);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -26,7 +26,7 @@ typedef
Files_BufDesc *Files_Buffer; Files_BufDesc *Files_Buffer;
typedef typedef
CHAR Files_FileName[101]; CHAR Files_FileName[256];
typedef typedef
struct Files_FileDesc { struct Files_FileDesc {
@ -48,6 +48,7 @@ typedef
} Files_Rider; } Files_Rider;
export INT16 Files_MaxPathLength, Files_MaxNameLength;
static Files_FileDesc *Files_files; static Files_FileDesc *Files_files;
static INT16 Files_tempno; static INT16 Files_tempno;
static CHAR Files_HOME[1024]; static CHAR Files_HOME[1024];
@ -85,6 +86,7 @@ export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f); export void Files_Purge (Files_File f);
export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
export void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
@ -129,17 +131,17 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
Out_String((CHAR*)": ", 3); Out_String((CHAR*)": ", 3);
if (f != NIL) { if (f != NIL) {
if (f->registerName[0] != 0x00) { if (f->registerName[0] != 0x00) {
Out_String(f->registerName, 101); Out_String(f->registerName, 256);
} else { } else {
Out_String(f->workName, 101); Out_String(f->workName, 256);
} }
if (f->fd != 0) { if (f->fd != 0) {
Out_String((CHAR*)"f.fd = ", 8); Out_String((CHAR*)", f.fd = ", 10);
Out_Int(f->fd, 1); Out_Int(f->fd, 1);
} }
} }
if (errcode != 0) { if (errcode != 0) {
Out_String((CHAR*)" errcode = ", 12); Out_String((CHAR*)", errcode = ", 13);
Out_Int(errcode, 1); Out_Int(errcode, 1);
} }
Out_Ln(); Out_Ln();
@ -149,76 +151,75 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len) static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len)
{ {
INT16 i, j; INT16 i, j, ld, ln;
__DUP(dir, dir__len, CHAR); __DUP(dir, dir__len, CHAR);
__DUP(name, name__len, CHAR); __DUP(name, name__len, CHAR);
ld = Strings_Length(dir, dir__len);
ln = Strings_Length(name, name__len);
while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) {
ld -= 1;
}
if (((ld + ln) + 2) > dest__len) {
Files_Err((CHAR*)"File name too long", 19, NIL, 0);
}
i = 0; i = 0;
while (i < ld) {
dest[__X(i, dest__len)] = dir[__X(i, dir__len)];
i += 1;
}
if (i > 0) {
dest[__X(i, dest__len)] = '/';
i += 1;
}
j = 0; j = 0;
while (dir[i] != 0x00) { while (j < ln) {
dest[i] = dir[i]; dest[__X(i, dest__len)] = name[__X(j, name__len)];
i += 1;
}
if (dest[i - 1] != '/') {
dest[i] = '/';
i += 1;
}
while (name[j] != 0x00) {
dest[i] = name[j];
i += 1; i += 1;
j += 1; j += 1;
} }
dest[i] = 0x00; dest[__X(i, dest__len)] = 0x00;
__DEL(dir); __DEL(dir);
__DEL(name); __DEL(name);
} }
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len) static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len)
{ {
INT32 n, i, j; INT16 i, n;
__DUP(finalName, finalName__len, CHAR); __DUP(finalName, finalName__len, CHAR);
Files_tempno += 1; if (finalName[0] == '/') {
n = Files_tempno; __COPY(finalName, name, name__len);
i = 0; } else {
if (finalName[0] != '/') { Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len);
while (Platform_CWD[i] != 0x00) {
name[i] = Platform_CWD[i];
i += 1;
}
if (Platform_CWD[i - 1] != '/') {
name[i] = '/';
i += 1;
}
} }
j = 0; i = Strings_Length(name, name__len) - 1;
while (finalName[j] != 0x00) { while ((i > 0 && name[__X(i, name__len)] != '/')) {
name[i] = finalName[j];
i += 1;
j += 1;
}
i -= 1;
while (name[i] != '/') {
i -= 1; i -= 1;
} }
name[i + 1] = '.'; if ((i + 16) >= name__len) {
name[i + 2] = 't'; Files_Err((CHAR*)"File name too long", 19, NIL, 0);
name[i + 3] = 'm'; }
name[i + 4] = 'p'; Files_tempno += 1;
name[i + 5] = '.'; n = Files_tempno;
name[__X(i + 1, name__len)] = '.';
name[__X(i + 2, name__len)] = 't';
name[__X(i + 3, name__len)] = 'm';
name[__X(i + 4, name__len)] = 'p';
name[__X(i + 5, name__len)] = '.';
i += 6; i += 6;
while (n > 0) { while (n > 0) {
name[i] = (CHAR)((int)__MOD(n, 10) + 48); name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
n = __DIV(n, 10); n = __DIV(n, 10);
i += 1; i += 1;
} }
name[i] = '.'; name[__X(i, name__len)] = '.';
i += 1; i += 1;
n = Platform_PID; n = Platform_PID;
while (n > 0) { while (n > 0) {
name[i] = (CHAR)((int)__MOD(n, 10) + 48); name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
n = __DIV(n, 10); n = __DIV(n, 10);
i += 1; i += 1;
} }
name[i] = 0x00; name[__X(i, name__len)] = 0x00;
__DEL(finalName); __DEL(finalName);
} }
@ -236,11 +237,11 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len)
if (osfile != NIL) { if (osfile != NIL) {
__ASSERT(!osfile->tempFile, 0); __ASSERT(!osfile->tempFile, 0);
__ASSERT(osfile->fd >= 0, 0); __ASSERT(osfile->fd >= 0, 0);
__MOVE(osfile->workName, osfile->registerName, 101); __MOVE(osfile->workName, osfile->registerName, 256);
Files_GetTempName(osfile->registerName, 101, (void*)osfile->workName, 101); Files_GetTempName(osfile->registerName, 256, (void*)osfile->workName, 256);
osfile->tempFile = 1; osfile->tempFile = 1;
osfile->state = 0; osfile->state = 0;
error = Platform_Rename((void*)osfile->registerName, 101, (void*)osfile->workName, 101); error = Platform_Rename((void*)osfile->registerName, 256, (void*)osfile->workName, 256);
if (error != 0) { if (error != 0) {
Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error); Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error);
} }
@ -256,17 +257,17 @@ static void Files_Create (Files_File f)
CHAR err[32]; CHAR err[32];
if (f->fd == -1) { if (f->fd == -1) {
if (f->state == 1) { if (f->state == 1) {
Files_GetTempName(f->registerName, 101, (void*)f->workName, 101); Files_GetTempName(f->registerName, 256, (void*)f->workName, 256);
f->tempFile = 1; f->tempFile = 1;
} else { } else {
__ASSERT(f->state == 2, 0); __ASSERT(f->state == 2, 0);
Files_Deregister(f->registerName, 101); Files_Deregister(f->registerName, 256);
__MOVE(f->registerName, f->workName, 101); __MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00; f->registerName[0] = 0x00;
f->tempFile = 0; f->tempFile = 0;
} }
error = Platform_Unlink((void*)f->workName, 101); error = Platform_Unlink((void*)f->workName, 256);
error = Platform_New((void*)f->workName, 101, &f->fd); error = Platform_New((void*)f->workName, 256, &f->fd);
done = error == 0; done = error == 0;
if (done) { if (done) {
f->next = Files_files; f->next = Files_files;
@ -319,8 +320,8 @@ void Files_Close (Files_File f)
if (f->state != 1 || f->registerName[0] != 0x00) { if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f); Files_Create(f);
i = 0; i = 0;
while ((i < 4 && f->bufs[i] != NIL)) { while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) {
Files_Flush(f->bufs[i]); Files_Flush(f->bufs[__X(i, 4)]);
i += 1; i += 1;
} }
} }
@ -337,7 +338,7 @@ Files_File Files_New (CHAR *name, ADDRESS name__len)
__DUP(name, name__len, CHAR); __DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc); __NEW(f, Files_FileDesc);
f->workName[0] = 0x00; f->workName[0] = 0x00;
__COPY(name, f->registerName, 101); __COPY(name, f->registerName, 256);
f->fd = -1; f->fd = -1;
f->state = 1; f->state = 1;
f->len = 0; f->len = 0;
@ -359,35 +360,35 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
*pos += 1; *pos += 1;
} }
} else { } else {
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (ch == ' ' || ch == ';') { while (ch == ' ' || ch == ';') {
*pos += 1; *pos += 1;
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
} }
if (ch == '~') { if (ch == '~') {
*pos += 1; *pos += 1;
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (Files_HOME[i] != 0x00) { while (Files_HOME[__X(i, 1024)] != 0x00) {
dir[i] = Files_HOME[i]; dir[__X(i, dir__len)] = Files_HOME[__X(i, 1024)];
i += 1; i += 1;
} }
if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) {
while ((i > 0 && dir[i - 1] != '/')) { while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) {
i -= 1; i -= 1;
} }
} }
} }
while ((ch != 0x00 && ch != ';')) { while ((ch != 0x00 && ch != ';')) {
dir[i] = ch; dir[__X(i, dir__len)] = ch;
i += 1; i += 1;
*pos += 1; *pos += 1;
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
} }
while ((i > 0 && dir[i - 1] == ' ')) { while ((i > 0 && dir[__X(i - 1, dir__len)] == ' ')) {
i -= 1; i -= 1;
} }
} }
dir[i] = 0x00; dir[__X(i, dir__len)] = 0x00;
} }
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
@ -398,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
ch = name[0]; ch = name[0];
while ((ch != 0x00 && ch != '/')) { while ((ch != 0x00 && ch != '/')) {
i += 1; i += 1;
ch = name[i]; ch = name[__X(i, name__len)];
} }
return ch == '/'; return ch == '/';
} }
@ -413,9 +414,9 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
if (!Platform_SameFileTime(identity, f->identity)) { if (!Platform_SameFileTime(identity, f->identity)) {
i = 0; i = 0;
while (i < 4) { while (i < 4) {
if (f->bufs[i] != NIL) { if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[i]->org = -1; f->bufs[__X(i, 4)]->org = -1;
f->bufs[i] = NIL; f->bufs[__X(i, 4)] = NIL;
} }
i += 1; i += 1;
} }
@ -482,7 +483,7 @@ Files_File Files_Old (CHAR *name, ADDRESS name__len)
f->pos = 0; f->pos = 0;
f->swapper = -1; f->swapper = -1;
error = Platform_Size(fd, &f->len); error = Platform_Size(fd, &f->len);
__COPY(name, f->workName, 101); __COPY(name, f->workName, 256);
f->registerName[0] = 0x00; f->registerName[0] = 0x00;
f->tempFile = 0; f->tempFile = 0;
f->identity = identity; f->identity = identity;
@ -514,9 +515,9 @@ void Files_Purge (Files_File f)
INT16 error; INT16 error;
i = 0; i = 0;
while (i < 4) { while (i < 4) {
if (f->bufs[i] != NIL) { if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[i]->org = -1; f->bufs[__X(i, 4)]->org = -1;
f->bufs[i] = NIL; f->bufs[__X(i, 4)] = NIL;
} }
i += 1; i += 1;
} }
@ -560,22 +561,22 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
offset = __MASK(pos, -4096); offset = __MASK(pos, -4096);
org = pos - offset; org = pos - offset;
i = 0; i = 0;
while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { while ((((i < 4 && f->bufs[__X(i, 4)] != NIL)) && org != f->bufs[__X(i, 4)]->org)) {
i += 1; i += 1;
} }
if (i < 4) { if (i < 4) {
if (f->bufs[i] == NIL) { if (f->bufs[__X(i, 4)] == NIL) {
__NEW(buf, Files_BufDesc); __NEW(buf, Files_BufDesc);
buf->chg = 0; buf->chg = 0;
buf->org = -1; buf->org = -1;
buf->f = f; buf->f = f;
f->bufs[i] = buf; f->bufs[__X(i, 4)] = buf;
} else { } else {
buf = f->bufs[i]; buf = f->bufs[__X(i, 4)];
} }
} else { } else {
f->swapper = __MASK(f->swapper + 1, -4); f->swapper = __MASK(f->swapper + 1, -4);
buf = f->bufs[f->swapper]; buf = f->bufs[__X(f->swapper, 4)];
Files_Flush(buf); Files_Flush(buf);
} }
if (buf->org != org) { if (buf->org != org) {
@ -622,7 +623,7 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
} }
Files_Assert(offset <= buf->size); Files_Assert(offset <= buf->size);
if (offset < buf->size) { if (offset < buf->size) {
*x = buf->data[offset]; *x = buf->data[__X(offset, 4096)];
(*r).offset = offset + 1; (*r).offset = offset + 1;
} else if ((*r).org + offset < buf->f->len) { } else if ((*r).org + offset < buf->f->len) {
Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset);
@ -634,6 +635,11 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
} }
} }
void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
{
Files_Read(&*r, r__typ, &*x);
}
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n) void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
{ {
INT32 xpos, min, restInBuf, offset; INT32 xpos, min, restInBuf, offset;
@ -660,7 +666,7 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x
} else { } else {
min = n; min = n;
} }
__MOVE((ADDRESS)&buf->data[offset], (ADDRESS)&x[xpos], min); __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
offset += min; offset += min;
(*r).offset = offset; (*r).offset = offset;
xpos += min; xpos += min;
@ -689,7 +695,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
offset = (*r).offset; offset = (*r).offset;
} }
Files_Assert(offset < 4096); Files_Assert(offset < 4096);
buf->data[offset] = x; buf->data[__X(offset, 4096)] = x;
buf->chg = 1; buf->chg = 1;
if (offset == buf->size) { if (offset == buf->size) {
buf->size += 1; buf->size += 1;
@ -723,7 +729,7 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS
} else { } else {
min = n; min = n;
} }
__MOVE((ADDRESS)&x[xpos], (ADDRESS)&buf->data[offset], min); __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
offset += min; offset += min;
(*r).offset = offset; (*r).offset = offset;
Files_Assert(offset <= 4096); Files_Assert(offset <= 4096);
@ -817,12 +823,12 @@ void Files_Register (Files_File f)
} }
Files_Close(f); Files_Close(f);
if (f->registerName[0] != 0x00) { if (f->registerName[0] != 0x00) {
Files_Deregister(f->registerName, 101); Files_Deregister(f->registerName, 256);
Files_Rename(f->workName, 101, f->registerName, 101, &errcode); Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
if (errcode != 0) { if (errcode != 0) {
Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode); Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
} }
__MOVE(f->registerName, f->workName, 101); __MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00; f->registerName[0] = 0x00;
f->tempFile = 0; f->tempFile = 0;
} }
@ -843,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *de
j = 0; j = 0;
while (i > 0) { while (i > 0) {
i -= 1; i -= 1;
dest[j] = src[i]; dest[__X(j, dest__len)] = src[__X(i, src__len)];
j += 1; j += 1;
} }
} else { } else {
@ -900,7 +906,7 @@ void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
i = 0; i = 0;
do { do {
Files_Read(&*R, R__typ, (void*)&ch); Files_Read(&*R, R__typ, (void*)&ch);
x[i] = ch; x[__X(i, x__len)] = ch;
i += 1; i += 1;
} while (!(ch == 0x00)); } while (!(ch == 0x00));
} }
@ -910,16 +916,16 @@ void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
INT16 i; INT16 i;
i = 0; i = 0;
do { do {
Files_Read(&*R, R__typ, (void*)&x[i]); Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]);
i += 1; i += 1;
} while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a)); } while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a));
if (x[i - 1] == 0x0a) { if (x[__X(i - 1, x__len)] == 0x0a) {
i -= 1; i -= 1;
} }
if ((i > 0 && x[i - 1] == 0x0d)) { if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) {
i -= 1; i -= 1;
} }
x[i] = 0x00; x[__X(i, x__len)] = 0x00;
} }
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len) void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
@ -947,18 +953,18 @@ void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x)
void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x) void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x)
{ {
CHAR b[2]; CHAR b[2];
b[0] = (CHAR)x; b[0] = __CHR(x);
b[1] = (CHAR)__ASHR(x, 8); b[1] = __CHR(__ASHR(x, 8));
Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2); Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2);
} }
void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x) void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x)
{ {
CHAR b[4]; CHAR b[4];
b[0] = (CHAR)x; b[0] = __CHR(x);
b[1] = (CHAR)__ASHR(x, 8); b[1] = __CHR(__ASHR(x, 8));
b[2] = (CHAR)__ASHR(x, 16); b[2] = __CHR(__ASHR(x, 16));
b[3] = (CHAR)__ASHR(x, 24); b[3] = __CHR(__ASHR(x, 24));
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
} }
@ -966,11 +972,13 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{ {
CHAR b[4]; CHAR b[4];
INT32 i; INT32 i;
i = (INT32)x; UINT64 y;
b[0] = (CHAR)i; y = x;
b[1] = (CHAR)__ASHR(i, 8); i = __VAL(INT32, y);
b[2] = (CHAR)__ASHR(i, 16); b[0] = __CHR(i);
b[3] = (CHAR)__ASHR(i, 24); b[1] = __CHR(__ASHR(i, 8));
b[2] = __CHR(__ASHR(i, 16));
b[3] = __CHR(__ASHR(i, 24));
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
} }
@ -992,7 +1000,7 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len
{ {
INT16 i; INT16 i;
i = 0; i = 0;
while (x[i] != 0x00) { while (x[__X(i, x__len)] != 0x00) {
i += 1; i += 1;
} }
Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1); Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
@ -1001,10 +1009,10 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len
void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x) void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{ {
while (x < -64 || x > 63) { while (x < -64 || x > 63) {
Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); Files_Write(&*R, R__typ, __CHR(__MASK(x, -128) + 128));
x = __ASHR(x, 7); x = __ASHR(x, 7);
} }
Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); Files_Write(&*R, R__typ, __CHR(__MASK(x, -128)));
} }
void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len) void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
@ -1041,7 +1049,7 @@ static void Files_Finalize (SYSTEM_PTR o)
if (f->fd >= 0) { if (f->fd >= 0) {
Files_CloseOSFile(f); Files_CloseOSFile(f);
if (f->tempFile) { if (f->tempFile) {
res = Platform_Unlink((void*)f->workName, 101); res = Platform_Unlink((void*)f->workName, 256);
} }
} }
} }
@ -1063,7 +1071,7 @@ static void EnumPtrs(void (*P)(void*))
P(Files_SearchPath); P(Files_SearchPath);
} }
__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 252), {228, 232, 236, 240, -20}}; __TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 564), {540, 544, 548, 552, -20}};
__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}}; __TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}};
__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}}; __TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}};
@ -1083,5 +1091,7 @@ export void *Files__init(void)
Heap_FileCount = 0; Heap_FileCount = 0;
Files_HOME[0] = 0x00; Files_HOME[0] = 0x00;
Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024); Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024);
Files_MaxPathLength = Platform_MaxPathLength();
Files_MaxNameLength = Platform_MaxNameLength();
__ENDMOD; __ENDMOD;
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Files__h #ifndef Files__h
#define Files__h #define Files__h
@ -11,7 +11,7 @@ typedef
typedef typedef
struct Files_FileDesc { struct Files_FileDesc {
INT32 _prvt0; INT32 _prvt0;
char _prvt1[248]; char _prvt1[560];
} Files_FileDesc; } Files_FileDesc;
typedef typedef
@ -22,6 +22,7 @@ typedef
} Files_Rider; } Files_Rider;
import INT16 Files_MaxPathLength, Files_MaxNameLength;
import ADDRESS *Files_FileDesc__typ; import ADDRESS *Files_FileDesc__typ;
import ADDRESS *Files_Rider__typ; import ADDRESS *Files_Rider__typ;
@ -39,6 +40,7 @@ import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
import void Files_Purge (Files_File f); import void Files_Purge (Files_File f);
import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
import void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -68,9 +68,10 @@ static INT32 Heap_freeList[10];
static INT32 Heap_bigBlocks; static INT32 Heap_bigBlocks;
export INT32 Heap_allocated; export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry; static BOOLEAN Heap_firstTry;
static INT16 Heap_ldUnit;
export INT32 Heap_heap; export INT32 Heap_heap;
static INT32 Heap_heapMin, Heap_heapMax; static INT32 Heap_heapMin, Heap_heapMax;
export INT32 Heap_heapsize; export INT32 Heap_heapsize, Heap_heapMinExpand;
static Heap_FinNode Heap_fin; static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth; static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted; static BOOLEAN Heap_interrupted;
@ -228,10 +229,10 @@ static INT32 Heap_NewChunk (INT32 blksz)
static void Heap_ExtendHeap (INT32 blksz) static void Heap_ExtendHeap (INT32 blksz)
{ {
INT32 size, chnk, j, next; INT32 size, chnk, j, next;
if (Heap_uLT(160000, blksz)) { if (Heap_uLT(Heap_heapMinExpand, blksz)) {
size = blksz; size = blksz;
} else { } else {
size = 160000; size = Heap_heapMinExpand;
} }
chnk = Heap_NewChunk(size); chnk = Heap_NewChunk(size);
if (chnk != 0) { if (chnk != 0) {
@ -248,6 +249,8 @@ static void Heap_ExtendHeap (INT32 blksz)
__PUT(chnk, next, INT32); __PUT(chnk, next, INT32);
__PUT(j, chnk, INT32); __PUT(j, chnk, INT32);
} }
} else if (!Heap_firstTry) {
Heap_heapMinExpand = 16;
} }
} }
@ -257,16 +260,16 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
SYSTEM_PTR new; SYSTEM_PTR new;
Heap_Lock(); Heap_Lock();
__GET(tag, blksz, INT32); __GET(tag, blksz, INT32);
i0 = __ASHR(blksz, 4); i0 = __LSH(blksz, -Heap_ldUnit, 32);
i = i0; i = i0;
if (Heap_uLT(i, 9)) { if (i < 9) {
adr = Heap_freeList[i]; adr = Heap_freeList[i];
while (adr == 0) { while (adr == 0) {
i += 1; i += 1;
adr = Heap_freeList[i]; adr = Heap_freeList[i];
} }
} }
if (Heap_uLT(i, 9)) { if (i < 9) {
__GET(adr + 12, next, INT32); __GET(adr + 12, next, INT32);
Heap_freeList[i] = next; Heap_freeList[i] = next;
if (i != i0) { if (i != i0) {
@ -289,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
if (Heap_firstTry) { if (Heap_firstTry) {
Heap_GC(1); Heap_GC(1);
blksz += 16; blksz += 16;
if (Heap_uLT(Heap_heapsize - Heap_allocated, blksz) || Heap_uLT(__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2), Heap_heapsize)) { t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 32) * 80;
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); if (Heap_uLT(Heap_heapsize, t)) {
Heap_ExtendHeap(t - Heap_heapsize);
} }
Heap_firstTry = 0; Heap_firstTry = 0;
new = Heap_NEWREC(tag); new = Heap_NEWREC(tag);
Heap_firstTry = 1;
if (new == NIL) { if (new == NIL) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); Heap_ExtendHeap(blksz);
new = Heap_NEWREC(tag); new = Heap_NEWREC(tag);
} }
Heap_firstTry = 1;
Heap_Unlock(); Heap_Unlock();
return new; return new;
} else { } else {
@ -443,7 +447,7 @@ static void Heap_Scan (void)
__PUT(start, start + 4, INT32); __PUT(start, start + 4, INT32);
__PUT(start + 4, freesize, INT32); __PUT(start + 4, freesize, INT32);
__PUT(start + 8, -4, INT32); __PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4); i = __LSH(freesize, -Heap_ldUnit, 32);
freesize = 0; freesize = 0;
if (Heap_uLT(i, 9)) { if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32); __PUT(start + 12, Heap_freeList[i], INT32);
@ -469,7 +473,7 @@ static void Heap_Scan (void)
__PUT(start, start + 4, INT32); __PUT(start, start + 4, INT32);
__PUT(start + 4, freesize, INT32); __PUT(start + 4, freesize, INT32);
__PUT(start + 8, -4, INT32); __PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4); i = __LSH(freesize, -Heap_ldUnit, 32);
freesize = 0; freesize = 0;
if (Heap_uLT(i, 9)) { if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32); __PUT(start + 12, Heap_freeList[i], INT32);
@ -661,79 +665,77 @@ void Heap_GC (BOOLEAN markStack)
Heap_Module m; Heap_Module m;
INT32 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; INT32 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
INT32 cand[10000]; INT32 cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { Heap_Lock();
Heap_Lock(); m = (Heap_Module)(ADDRESS)Heap_modules;
m = (Heap_Module)(ADDRESS)Heap_modules; while (m != NIL) {
while (m != NIL) { if (m->enumPtrs != NIL) {
if (m->enumPtrs != NIL) { (*m->enumPtrs)(Heap_MarkP);
(*m->enumPtrs)(Heap_MarkP);
}
m = m->next;
} }
if (markStack) { m = m->next;
i0 = -100;
i1 = -101;
i2 = -102;
i3 = -103;
i4 = -104;
i5 = -105;
i6 = -106;
i7 = -107;
i8 = 1;
i9 = 2;
i10 = 3;
i11 = 4;
i12 = 5;
i13 = 6;
i14 = 7;
i15 = 8;
i16 = 9;
i17 = 10;
i18 = 11;
i19 = 12;
i20 = 13;
i21 = 14;
i22 = 15;
i23 = 16;
for (;;) {
i0 += 1;
i1 += 2;
i2 += 3;
i3 += 4;
i4 += 5;
i5 += 6;
i6 += 7;
i7 += 8;
i8 += 9;
i9 += 10;
i10 += 11;
i11 += 12;
i12 += 13;
i13 += 14;
i14 += 15;
i15 += 16;
i16 += 17;
i17 += 18;
i18 += 19;
i19 += 20;
i20 += 21;
i21 += 22;
i22 += 23;
i23 += 24;
if ((i0 == -99 && i15 == 24)) {
Heap_MarkStack(32, (void*)cand, 10000);
break;
}
}
if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) {
return;
}
}
Heap_CheckFin();
Heap_Scan();
Heap_Finalize();
Heap_Unlock();
} }
if (markStack) {
i0 = -100;
i1 = -101;
i2 = -102;
i3 = -103;
i4 = -104;
i5 = -105;
i6 = -106;
i7 = -107;
i8 = 1;
i9 = 2;
i10 = 3;
i11 = 4;
i12 = 5;
i13 = 6;
i14 = 7;
i15 = 8;
i16 = 9;
i17 = 10;
i18 = 11;
i19 = 12;
i20 = 13;
i21 = 14;
i22 = 15;
i23 = 16;
for (;;) {
i0 += 1;
i1 += 2;
i2 += 3;
i3 += 4;
i4 += 5;
i5 += 6;
i6 += 7;
i7 += 8;
i8 += 9;
i9 += 10;
i10 += 11;
i11 += 12;
i12 += 13;
i13 += 14;
i14 += 15;
i15 += 16;
i16 += 17;
i17 += 18;
i18 += 19;
i19 += 20;
i20 += 21;
i21 += 22;
i22 += 23;
i23 += 24;
if ((i0 == -99 && i15 == 24)) {
Heap_MarkStack(32, (void*)cand, 10000);
break;
}
}
if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) {
return;
}
}
Heap_CheckFin();
Heap_Scan();
Heap_Finalize();
Heap_Unlock();
} }
void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize) void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
@ -756,6 +758,8 @@ void Heap_InitHeap (void)
Heap_heapMin = -1; Heap_heapMin = -1;
Heap_heapMax = 0; Heap_heapMax = 0;
Heap_bigBlocks = 0; Heap_bigBlocks = 0;
Heap_heapMinExpand = 128000;
Heap_ldUnit = 4;
Heap_heap = Heap_NewChunk(128000); Heap_heap = Heap_NewChunk(128000);
__PUT(Heap_heap, 0, INT32); __PUT(Heap_heap, 0, INT32);
Heap_firstTry = 1; Heap_firstTry = 1;

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#ifndef Heap__h #ifndef Heap__h
#define Heap__h #define Heap__h
@ -48,7 +48,7 @@ typedef
import SYSTEM_PTR Heap_modules; import SYSTEM_PTR Heap_modules;
import INT32 Heap_allocated; import INT32 Heap_allocated;
import INT32 Heap_heap; import INT32 Heap_heap;
import INT32 Heap_heapsize; import INT32 Heap_heapsize, Heap_heapMinExpand;
import INT16 Heap_FileCount; import INT16 Heap_FileCount;
import ADDRESS *Heap_ModuleDesc__typ; import ADDRESS *Heap_ModuleDesc__typ;

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -404,7 +404,7 @@ static void Modules_errint (INT32 l)
if (l >= 10) { if (l >= 10) {
Modules_errint(__DIV(l, 10)); Modules_errint(__DIV(l, 10));
} }
Modules_errch((CHAR)((int)__MOD(l, 10) + 48)); Modules_errch(__CHR((int)__MOD(l, 10) + 48));
} }
static void Modules_DisplayHaltCode (INT32 code) static void Modules_DisplayHaltCode (INT32 code)

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Modules__h #ifndef Modules__h
#define Modules__h #define Modules__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -261,7 +261,7 @@ static void OPB_CharToString (OPT_Node n)
{ {
CHAR ch; CHAR ch;
n->typ = OPT_stringtyp; n->typ = OPT_stringtyp;
ch = (CHAR)n->conval->intval; ch = __CHR(n->conval->intval);
n->conval->ext = OPT_NewExt(); n->conval->ext = OPT_NewExt();
if (ch == 0x00) { if (ch == 0x00) {
n->conval->intval2 = 1; n->conval->intval2 = 1;
@ -597,7 +597,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
case 22: case 22:
if (f == 3) { if (f == 3) {
if (z->class == 7) { if (z->class == 7) {
z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval); z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__29(op, typ, z);
@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203); OPB_err(203);
r = (LONGREAL)1; r = (LONGREAL)1;
} }
(*x)->conval->intval = (INT32)__ENTIER(r); (*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL);
OPB_SetIntType(*x); OPB_SetIntType(*x);
} }
} }
@ -1626,6 +1626,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
if (x == y) { if (x == y) {
} else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) { } else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) {
} else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) { } else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) {
OPB_err(113);
} else if (x->BaseTyp == OPT_chartyp) { } else if (x->BaseTyp == OPT_chartyp) {
if (g == 8) { if (g == 8) {
if (ynode->conval->intval2 > x->n) { if (ynode->conval->intval2 > x->n) {

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPB__h #ifndef OPB__h
#define OPB__h #define OPB__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -618,31 +618,33 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
{ {
if (obj != NIL) { if (obj != NIL) {
OPC_DefineTProcMacros(obj->left, &*empty); OPC_DefineTProcMacros(obj->left, &*empty);
if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) { if ((obj->mode == 13 && obj == OPC_BaseTProc(obj))) {
OPM_WriteString((CHAR*)"#define __", 11); if (OPM_currFile == 1 || (OPM_currFile == 0 && obj->vis == 1)) {
OPC_Ident(obj); OPM_WriteString((CHAR*)"#define __", 11);
OPC_DeclareParams(obj->link, 1); OPC_Ident(obj);
OPM_WriteString((CHAR*)" __SEND(", 9); OPC_DeclareParams(obj->link, 1);
if (obj->link->typ->form == 11) { OPM_WriteString((CHAR*)" __SEND(", 9);
OPM_WriteString((CHAR*)"__TYPEOF(", 10); if (obj->link->typ->form == 11) {
OPC_Ident(obj->link); OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPC_Ident(obj->link);
OPM_Write(')');
} else {
OPC_Ident(obj->link);
OPM_WriteString((CHAR*)"__typ", 6);
}
OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
if (obj->typ == OPT_notyp) {
OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(obj->typ->strobj);
}
OPM_WriteString((CHAR*)"(*)", 4);
OPC_AnsiParamList(obj->link, 0);
OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareParams(obj->link, 1);
OPM_Write(')'); OPM_Write(')');
} else { OPM_WriteLn();
OPC_Ident(obj->link);
OPM_WriteString((CHAR*)"__typ", 6);
} }
OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
if (obj->typ == OPT_notyp) {
OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(obj->typ->strobj);
}
OPM_WriteString((CHAR*)"(*)", 4);
OPC_AnsiParamList(obj->link, 0);
OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareParams(obj->link, 1);
OPM_Write(')');
OPM_WriteLn();
} }
OPC_DefineTProcMacros(obj->right, &*empty); OPC_DefineTProcMacros(obj->right, &*empty);
} }
@ -652,7 +654,7 @@ static void OPC_DefineType (OPT_Struct str)
{ {
OPT_Object obj = NIL, field = NIL, par = NIL; OPT_Object obj = NIL, field = NIL, par = NIL;
BOOLEAN empty; BOOLEAN empty;
if (OPM_currFile == 1 || str->ref < 255) { if ((OPM_currFile == 1 || str->ref < 255) || (((OPM_currFile == 0 && str->strobj != NIL)) && str->strobj->vis == 1)) {
obj = str->strobj; obj = str->strobj;
if (obj == NIL || OPC_Undefined(obj)) { if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) { if (obj != NIL) {
@ -681,6 +683,10 @@ static void OPC_DefineType (OPT_Struct str)
OPC_DefineType(str->BaseTyp); OPC_DefineType(str->BaseTyp);
} }
} else if (__IN(str->comp, 0x0c, 32)) { } else if (__IN(str->comp, 0x0c, 32)) {
if ((str->BaseTyp->strobj != NIL && str->BaseTyp->strobj->linkadr == 1)) {
OPM_Mark(244, str->txtpos);
str->BaseTyp->strobj->linkadr = 2;
}
OPC_DefineType(str->BaseTyp); OPC_DefineType(str->BaseTyp);
} else if (str->form == 12) { } else if (str->form == 12) {
if (str->BaseTyp != OPT_notyp) { if (str->BaseTyp != OPT_notyp) {
@ -715,6 +721,13 @@ static void OPC_DefineType (OPT_Struct str)
if (!empty) { if (!empty) {
OPM_WriteLn(); OPM_WriteLn();
} }
} else if ((obj->typ->form == 11 && obj->typ->BaseTyp->comp == 4)) {
empty = 1;
OPC_DeclareTProcs(obj->typ->BaseTyp->link, &empty);
OPC_DefineTProcMacros(obj->typ->BaseTyp->link, &empty);
if (!empty) {
OPM_WriteLn();
}
} }
} }
} }
@ -1138,7 +1151,7 @@ static void OPC_GenHeaderMsg (void)
OPM_WriteString((CHAR*)"/* ", 4); OPM_WriteString((CHAR*)"/* ", 4);
OPM_WriteString((CHAR*)"voc", 4); OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' '); OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, 75); OPM_WriteString(Configuration_versionLong, 76);
OPM_Write(' '); OPM_Write(' ');
i = 0; i = 0;
while (i <= 31) { while (i <= 31) {
@ -1739,7 +1752,7 @@ static void OPC_CharacterLiteral (INT64 c)
if ((c == 92 || c == 39) || c == 63) { if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\'); OPM_Write('\\');
} }
OPM_Write((CHAR)c); OPM_Write(__CHR(c));
OPM_Write('\''); OPM_Write('\'');
} }
} }
@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
c = (INT16)s[__X(i, s__len)]; c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) { if (c < 32 || c > 126) {
OPM_Write('\\'); OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6))); OPM_Write(__CHR(48 + __ASHR(c, 6)));
c = __MASK(c, -64); c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3))); OPM_Write(__CHR(48 + __ASHR(c, 3)));
c = __MASK(c, -8); c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c)); OPM_Write(__CHR(48 + c));
} else { } else {
if ((c == 92 || c == 34) || c == 63) { if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\'); OPM_Write('\\');
} }
OPM_Write((CHAR)c); OPM_Write(__CHR(c));
} }
i += 1; i += 1;
} }
@ -1830,6 +1843,12 @@ void OPC_IntLiteral (INT64 n, INT32 size)
void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
{ {
INT64 d;
d = dim;
while (d > 0) {
array = array->BaseTyp;
d -= 1;
}
if (array->comp == 3) { if (array->comp == 3) {
OPC_CompleteIdent(obj); OPC_CompleteIdent(obj);
OPM_WriteString((CHAR*)"__len", 6); OPM_WriteString((CHAR*)"__len", 6);
@ -1837,10 +1856,6 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
OPM_WriteInt(dim); OPM_WriteInt(dim);
} }
} else { } else {
while (dim > 0) {
array = array->BaseTyp;
dim -= 1;
}
OPM_WriteInt(array->n); OPM_WriteInt(array->n);
} }
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPC__h #ifndef OPC__h
#define OPC__h #define OPC__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -19,6 +19,8 @@ typedef
CHAR OPM_FileName[32]; CHAR OPM_FileName[32];
static CHAR OPM_currentComment[256];
static BOOLEAN OPM_hasComment;
static CHAR OPM_SourceFileName[256]; static CHAR OPM_SourceFileName[256];
static CHAR OPM_GlobalModel[10]; static CHAR OPM_GlobalModel[10];
export CHAR OPM_Model[10]; export CHAR OPM_Model[10];
@ -27,7 +29,7 @@ export INT16 OPM_AddressSize;
static INT16 OPM_GlobalAlignment; static INT16 OPM_GlobalAlignment;
export INT16 OPM_Alignment; export INT16 OPM_Alignment;
export UINT32 OPM_GlobalOptions, OPM_Options; export UINT32 OPM_GlobalOptions, OPM_Options;
export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
export INT64 OPM_MaxIndex; export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr; export BOOLEAN OPM_noerr;
@ -59,6 +61,7 @@ static void OPM_FindInstallDir (void);
static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos); static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len); static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch); export void OPM_Get (CHAR *ch);
export void OPM_GetComment (CHAR *text, ADDRESS text__len);
export void OPM_Init (BOOLEAN *done); export void OPM_Init (BOOLEAN *done);
export void OPM_InitOptions (void); export void OPM_InitOptions (void);
export INT16 OPM_Integer (INT64 n); export INT16 OPM_Integer (INT64 n);
@ -82,6 +85,7 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len);
static void OPM_ShowLine (INT64 pos); static void OPM_ShowLine (INT64 pos);
export INT64 OPM_SignedMaximum (INT32 bytecount); export INT64 OPM_SignedMaximum (INT32 bytecount);
export INT64 OPM_SignedMinimum (INT32 bytecount); export INT64 OPM_SignedMinimum (INT32 bytecount);
export void OPM_StoreComment (CHAR *text, ADDRESS text__len);
export void OPM_SymRCh (CHAR *ch); export void OPM_SymRCh (CHAR *ch);
export INT32 OPM_SymRInt (void); export INT32 OPM_SymRInt (void);
export INT64 OPM_SymRInt64 (void); export INT64 OPM_SymRInt64 (void);
@ -157,6 +161,36 @@ void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
__DEL(modname); __DEL(modname);
} }
void OPM_StoreComment (CHAR *text, ADDRESS text__len)
{
INT16 i;
__DUP(text, text__len, CHAR);
i = 0;
while ((i < 255 && text[__X(i, text__len)] != 0x00)) {
OPM_currentComment[__X(i, 256)] = text[__X(i, text__len)];
i += 1;
}
OPM_currentComment[__X(i, 256)] = 0x00;
OPM_hasComment = 1;
__DEL(text);
}
void OPM_GetComment (CHAR *text, ADDRESS text__len)
{
INT16 i;
if (OPM_hasComment) {
i = 0;
while ((((i < text__len && i < 256)) && OPM_currentComment[__X(i, 256)] != 0x00)) {
text[__X(i, text__len)] = OPM_currentComment[__X(i, 256)];
i += 1;
}
text[__X(i, text__len)] = 0x00;
OPM_hasComment = 0;
} else {
text[0] = 0x00;
}
}
INT64 OPM_SignedMaximum (INT32 bytecount) INT64 OPM_SignedMaximum (INT32 bytecount)
{ {
INT64 result; INT64 result;
@ -272,7 +306,7 @@ BOOLEAN OPM_OpenPar (void)
if (Modules_ArgCount == 1) { if (Modules_ArgCount == 1) {
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20); OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
OPM_LogWStr(Configuration_versionLong, 75); OPM_LogWStr(Configuration_versionLong, 76);
OPM_LogW('.'); OPM_LogW('.');
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52); OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52);
@ -338,7 +372,7 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
@ -410,21 +444,25 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
case 'C': case 'C':
OPM_ShortintSize = 2; OPM_ShortintSize = 2;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 4;
break; break;
case 'V': case 'V':
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 8;
break; break;
default: default:
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
} }
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024); __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
@ -606,7 +644,7 @@ static void OPM_ShowLine (INT64 pos)
if (pos >= (INT64)OPM_ErrorLineLimitPos) { if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1; pos = OPM_ErrorLineLimitPos - 1;
} }
i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos); i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768);
while (i > 0) { while (i > 0) {
OPM_LogW(' '); OPM_LogW(' ');
i -= 1; i -= 1;
@ -759,7 +797,7 @@ void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0); Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
if (tag != 0xf7 || ver != 0x83) { if (tag != 0xf7 || ver != 0x84) {
if (!__IN(4, OPM_Options, 32)) { if (!__IN(4, OPM_Options, 32)) {
OPM_err(-306); OPM_err(-306);
} }
@ -830,7 +868,7 @@ void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
if (OPM_newSFile != NIL) { if (OPM_newSFile != NIL) {
Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0); Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x83); Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
} else { } else {
OPM_err(153); OPM_err(153);
} }
@ -865,17 +903,17 @@ void OPM_WriteHex (INT64 i)
{ {
CHAR s[3]; CHAR s[3];
INT32 digit; INT32 digit;
digit = __ASHR((INT32)i, 4); digit = __ASHR(__SHORT(i, 2147483648LL), 4);
if (digit < 10) { if (digit < 10) {
s[0] = (CHAR)(48 + digit); s[0] = __CHR(48 + digit);
} else { } else {
s[0] = (CHAR)(87 + digit); s[0] = __CHR(87 + digit);
} }
digit = __MASK((INT32)i, -16); digit = __MASK(__SHORT(i, 2147483648LL), -16);
if (digit < 10) { if (digit < 10) {
s[1] = (CHAR)(48 + digit); s[1] = __CHR(48 + digit);
} else { } else {
s[1] = (CHAR)(87 + digit); s[1] = __CHR(87 + digit);
} }
s[2] = 0x00; s[2] = 0x00;
OPM_WriteString(s, 3); OPM_WriteString(s, 3);
@ -897,11 +935,11 @@ void OPM_WriteInt (INT64 i)
__MOVE("LL", s, 3); __MOVE("LL", s, 3);
k = 2; k = 2;
} }
s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10); i1 = __DIV(i1, 10);
k += 1; k += 1;
while (i1 > 0) { while (i1 > 0) {
s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10); i1 = __DIV(i1, 10);
k += 1; k += 1;
} }
@ -924,13 +962,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
CHAR s[32]; CHAR s[32];
CHAR ch; CHAR ch;
INT16 i; INT16 i;
if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) { if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == (__SHORT(__ENTIER(r), 2147483648LL)))) {
if (suffx == 'f') { if (suffx == 'f') {
OPM_WriteString((CHAR*)"(REAL)", 7); OPM_WriteString((CHAR*)"(REAL)", 7);
} else { } else {
OPM_WriteString((CHAR*)"(LONGREAL)", 11); OPM_WriteString((CHAR*)"(LONGREAL)", 11);
} }
OPM_WriteInt((INT32)__ENTIER(r)); OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL));
} else { } else {
Texts_OpenWriter(&W, Texts_Writer__typ); Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') { if (suffx == 'f') {
@ -1139,5 +1177,7 @@ export void *OPM__init(void)
OPM_MinReal = -OPM_MaxReal; OPM_MinReal = -OPM_MaxReal;
OPM_MinLReal = -OPM_MaxLReal; OPM_MinLReal = -OPM_MaxLReal;
OPM_FindInstallDir(); OPM_FindInstallDir();
OPM_hasComment = 0;
OPM_currentComment[0] = 0x00;
__ENDMOD; __ENDMOD;
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPM__h #ifndef OPM__h
#define OPM__h #define OPM__h
@ -9,7 +9,7 @@
import CHAR OPM_Model[10]; import CHAR OPM_Model[10];
import INT16 OPM_AddressSize, OPM_Alignment; import INT16 OPM_AddressSize, OPM_Alignment;
import UINT32 OPM_GlobalOptions, OPM_Options; import UINT32 OPM_GlobalOptions, OPM_Options;
import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
import INT64 OPM_MaxIndex; import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr; import BOOLEAN OPM_noerr;
@ -30,6 +30,7 @@ import void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
import void OPM_FPrintReal (INT32 *fp, REAL val); import void OPM_FPrintReal (INT32 *fp, REAL val);
import void OPM_FPrintSet (INT32 *fp, UINT64 val); import void OPM_FPrintSet (INT32 *fp, UINT64 val);
import void OPM_Get (CHAR *ch); import void OPM_Get (CHAR *ch);
import void OPM_GetComment (CHAR *text, ADDRESS text__len);
import void OPM_Init (BOOLEAN *done); import void OPM_Init (BOOLEAN *done);
import void OPM_InitOptions (void); import void OPM_InitOptions (void);
import INT16 OPM_Integer (INT64 n); import INT16 OPM_Integer (INT64 n);
@ -48,6 +49,7 @@ import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void); import void OPM_RegisterNewSym (void);
import INT64 OPM_SignedMaximum (INT32 bytecount); import INT64 OPM_SignedMaximum (INT32 bytecount);
import INT64 OPM_SignedMinimum (INT32 bytecount); import INT64 OPM_SignedMinimum (INT32 bytecount);
import void OPM_StoreComment (CHAR *text, ADDRESS text__len);
import void OPM_SymRCh (CHAR *ch); import void OPM_SymRCh (CHAR *ch);
import INT32 OPM_SymRInt (void); import INT32 OPM_SymRInt (void);
import INT64 OPM_SymRInt64 (void); import INT64 OPM_SymRInt64 (void);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -634,7 +634,7 @@ static void OPP_StandProcCall (OPT_Node *x)
OPT_Node y = NIL; OPT_Node y = NIL;
INT8 m; INT8 m;
INT16 n; INT16 n;
m = (INT8)((INT16)(*x)->obj->adr); m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128);
n = 0; n = 0;
if (OPP_sym == 30) { if (OPP_sym == 30) {
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
@ -943,7 +943,7 @@ static void GetCode__19 (void)
(*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)]; (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
n += 1; n += 1;
} }
(*ext)[0] = (CHAR)n; (*ext)[0] = __CHR(n);
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
} else { } else {
for (;;) { for (;;) {
@ -956,14 +956,14 @@ static void GetCode__19 (void)
n = 1; n = 1;
} }
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
(*ext)[__X(n, 256)] = (CHAR)c; (*ext)[__X(n, 256)] = __CHR(c);
} }
if (OPP_sym == 19) { if (OPP_sym == 19) {
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
} else if (OPP_sym == 35) { } else if (OPP_sym == 35) {
OPP_err(19); OPP_err(19);
} else { } else {
(*ext)[0] = (CHAR)n; (*ext)[0] = __CHR(n);
break; break;
} }
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPP__h #ifndef OPP__h
#define OPP__h #define OPP__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym)
OPS_err(241); OPS_err(241);
break; break;
} }
OPS_str[i] = OPS_ch; OPS_str[__X(i, 256)] = OPS_ch;
i += 1; i += 1;
} }
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
OPS_str[i] = 0x00; OPS_str[__X(i, 256)] = 0x00;
OPS_intval = i + 1; OPS_intval = i + 1;
if (OPS_intval == 2) { if (OPS_intval == 2) {
*sym = 35; *sym = 35;
@ -76,7 +76,7 @@ static void OPS_Identifier (INT8 *sym)
INT16 i; INT16 i;
i = 0; i = 0;
do { do {
OPS_name[i] = OPS_ch; OPS_name[__X(i, 256)] = OPS_ch;
i += 1; i += 1;
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
} while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256)); } while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256));
@ -84,7 +84,7 @@ static void OPS_Identifier (INT8 *sym)
OPS_err(240); OPS_err(240);
i -= 1; i -= 1;
} }
OPS_name[i] = 0x00; OPS_name[__X(i, 256)] = 0x00;
*sym = 38; *sym = 38;
} }
@ -143,7 +143,7 @@ static void OPS_Number (void)
if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) { if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) {
if (m > 0 || OPS_ch != '0') { if (m > 0 || OPS_ch != '0') {
if (n < 24) { if (n < 24) {
dig[n] = OPS_ch; dig[__X(n, 24)] = OPS_ch;
n += 1; n += 1;
} }
m += 1; m += 1;
@ -173,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1; OPS_numtyp = 1;
if (n <= 2) { if (n <= 2) {
while (i < n) { while (i < n) {
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1);
i += 1; i += 1;
} }
} else { } else {
@ -187,7 +187,7 @@ static void OPS_Number (void)
OPS_intval = -1; OPS_intval = -1;
} }
while (i < n) { while (i < n) {
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1);
i += 1; i += 1;
} }
} else { } else {
@ -196,7 +196,7 @@ static void OPS_Number (void)
} else { } else {
OPS_numtyp = 2; OPS_numtyp = 2;
while (i < n) { while (i < n) {
d = Ord__7(dig[i], 0); d = Ord__7(dig[__X(i, 24)], 0);
i += 1; i += 1;
if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) { if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
OPS_intval = OPS_intval * 10 + (INT64)d; OPS_intval = OPS_intval * 10 + (INT64)d;
@ -214,7 +214,7 @@ static void OPS_Number (void)
expCh = 'E'; expCh = 'E';
while (n > 0) { while (n > 0) {
n -= 1; n -= 1;
f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; f = (Ord__7(dig[__X(n, 24)], 0) + f) / (LONGREAL)(LONGREAL)10;
} }
if (OPS_ch == 'E' || OPS_ch == 'D') { if (OPS_ch == 'E' || OPS_ch == 'D') {
expCh = OPS_ch; expCh = OPS_ch;
@ -279,32 +279,74 @@ static void Comment__2 (void);
static void Comment__2 (void) static void Comment__2 (void)
{ {
BOOLEAN isExported;
CHAR commentText[256];
INT16 i, nestLevel;
CHAR prevCh, nextCh;
i = 0;
while (i <= 255) {
commentText[__X(i, 256)] = 0x00;
i += 1;
}
isExported = 0;
i = 0;
nestLevel = 1;
prevCh = 0x00;
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
for (;;) { if (OPS_ch == '*') {
for (;;) { isExported = 1;
while (OPS_ch == '(') { OPM_Get(&OPS_ch);
if (OPS_ch == ')') {
commentText[0] = 0x00;
OPM_StoreComment(commentText, 256);
OPM_Get(&OPS_ch);
return;
}
}
while ((nestLevel > 0 && OPS_ch != 0x00)) {
if ((prevCh == '(' && OPS_ch == '*')) {
nestLevel += 1;
prevCh = 0x00;
} else if ((prevCh == '*' && OPS_ch == ')')) {
nestLevel -= 1;
if (nestLevel == 0) {
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
if (OPS_ch == '*') { } else {
Comment__2(); prevCh = 0x00;
}
} else {
if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
} }
} }
if (OPS_ch == '*') { prevCh = OPS_ch;
OPM_Get(&OPS_ch); }
break; if (nestLevel > 0) {
}
if (OPS_ch == 0x00) {
break;
}
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
} }
if (OPS_ch == ')') { }
OPM_Get(&OPS_ch); if (OPS_ch == 0x00) {
break; OPS_err(5);
}
if ((((((isExported && nestLevel == 0)) && prevCh != 0x00)) && prevCh != '*')) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
} else {
OPM_LogWStr((CHAR*)"Truncating final comment character", 35);
OPM_LogWLn();
} }
if (OPS_ch == 0x00) { }
OPS_err(5); if (isExported) {
break; if (i >= 256) {
OPM_LogWStr((CHAR*)"Warning: commentText overflow", 30);
OPM_LogWLn();
i = 255;
} }
commentText[__X(i, 256)] = 0x00;
OPM_StoreComment(commentText, 256);
} }
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPS__h #ifndef OPS__h
#define OPS__h #define OPS__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -83,6 +83,7 @@ typedef
OPT_Const conval; OPT_Const conval;
INT32 adr, linkadr; INT32 adr, linkadr;
INT16 x; INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc; } OPT_ObjDesc;
typedef typedef
@ -173,6 +174,7 @@ static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par); static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ); static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj); static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len);
export OPT_Struct OPT_SetType (INT32 size); export OPT_Struct OPT_SetType (INT32 size);
export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir); export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
export INT32 OPT_SizeAlignment (INT32 size); export INT32 OPT_SizeAlignment (INT32 size);
@ -352,7 +354,7 @@ void OPT_TypSize (OPT_Struct typ)
} }
typ->size = offset; typ->size = offset;
typ->align = base; typ->align = base;
typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8); typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768);
} else if (c == 2) { } else if (c == 2) {
OPT_TypSize(typ->BaseTyp); OPT_TypSize(typ->BaseTyp);
typ->size = typ->n * typ->BaseTyp->size; typ->size = typ->n * typ->BaseTyp->size;
@ -388,6 +390,10 @@ OPT_Object OPT_NewObj (void)
{ {
OPT_Object obj = NIL; OPT_Object obj = NIL;
__NEW(obj, OPT_ObjDesc); __NEW(obj, OPT_ObjDesc);
obj->typ = NIL;
obj->conval = NIL;
obj->comment = NIL;
obj->name[0] = 0x00;
return obj; return obj;
} }
@ -554,6 +560,8 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
OPT_Object ob0 = NIL, ob1 = NIL; OPT_Object ob0 = NIL, ob1 = NIL;
BOOLEAN left; BOOLEAN left;
INT8 mnolev; INT8 mnolev;
CHAR commentText[256];
INT16 j;
ob0 = OPT_topScope; ob0 = OPT_topScope;
ob1 = ob0->right; ob1 = ob0->right;
left = 0; left = 0;
@ -585,6 +593,16 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
__COPY(name, ob1->name, 256); __COPY(name, ob1->name, 256);
mnolev = OPT_topScope->mnolev; mnolev = OPT_topScope->mnolev;
ob1->mnolev = mnolev; ob1->mnolev = mnolev;
OPM_GetComment((void*)commentText, 256);
if (commentText[0] != 0x00) {
ob1->comment = __NEWARR(NIL, 1, 1, 1, 0, 256);
j = 0;
while ((j < 255 && commentText[__X(j, 256)] != 0x00)) {
(*ob1->comment)[__X(j, 256)] = commentText[__X(j, 256)];
j += 1;
}
(*ob1->comment)[__X(j, 256)] = 0x00;
}
break; break;
} }
} }
@ -1103,6 +1121,13 @@ static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
tag = OPM_SymRInt(); tag = OPM_SymRInt();
last = NIL; last = NIL;
while (tag != 18) { while (tag != 18) {
if (tag < 0 || tag > 100) {
OPM_LogWStr((CHAR*)"ERROR: Invalid tag value in InSign: ", 37);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return;
}
new = OPT_NewObj(); new = OPT_NewObj();
new->mnolev = -mno; new->mnolev = -mno;
if (last == NIL) { if (last == NIL) {
@ -1251,7 +1276,7 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0; obj->vis = 0;
tag = OPM_SymRInt(); tag = OPM_SymRInt();
if (tag == 35) { if (tag == 35) {
(*typ)->sysflag = (INT16)OPM_SymRInt(); (*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768);
tag = OPM_SymRInt(); tag = OPM_SymRInt();
} }
switch (tag) { switch (tag) {
@ -1381,7 +1406,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
INT32 tag; INT32 tag;
OPT_ConstExt ext = NIL; OPT_ConstExt ext = NIL;
OPS_Name commentText;
BOOLEAN hasComment;
INT16 j;
INT32 len;
tag = OPT_impCtxt.nextTag; tag = OPT_impCtxt.nextTag;
hasComment = 0;
while (tag == 41) {
len = OPM_SymRInt();
if (len < 0) {
len = 0;
}
if (len > 255) {
len = 255;
}
i = 0;
while (i < len) {
OPM_SymRCh(&commentText[__X(i, 256)]);
i += 1;
}
commentText[__X(i, 256)] = 0x00;
hasComment = 1;
tag = OPM_SymRInt();
}
OPT_impCtxt.nextTag = tag;
if (tag < 0 || tag > 50) {
OPM_LogWStr((CHAR*)"ERROR: Invalid tag in InObj: ", 30);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return NIL;
}
if (tag == 19) { if (tag == 19) {
OPT_InStruct(&typ); OPT_InStruct(&typ);
obj = typ->strobj; obj = typ->strobj;
@ -1397,7 +1452,7 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->conval = OPT_NewConst(); obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval); OPT_InConstant(tag, obj->conval);
obj->typ = OPT_InTyp(tag); obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) { } else if ((tag >= 31 && tag <= 33)) {
obj->conval = OPT_NewConst(); obj->conval = OPT_NewConst();
obj->conval->intval = -1; obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link); OPT_InSign(mno, &obj->typ, &obj->link);
@ -1412,8 +1467,8 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->mode = 9; obj->mode = 9;
ext = OPT_NewExt(); ext = OPT_NewExt();
obj->conval->ext = ext; obj->conval->ext = ext;
s = (INT16)OPM_SymRInt(); s = __SHORTF(OPM_SymRInt(), 32768);
(*ext)[0] = (CHAR)s; (*ext)[0] = __CHR(s);
i = 1; i = 1;
while (i <= s) { while (i <= s) {
OPM_SymRCh(&(*ext)[__X(i, 256)]); OPM_SymRCh(&(*ext)[__X(i, 256)]);
@ -1424,20 +1479,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32); OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
OPM_LogWNum(tag, 0); OPM_LogWNum(tag, 0);
OPM_LogWLn(); OPM_LogWLn();
OPM_err(155);
return NIL;
break; break;
} }
} else if (tag == 20) { } else if (tag == 20) {
obj->mode = 5; obj->mode = 5;
OPT_InStruct(&obj->typ); OPT_InStruct(&obj->typ);
} else { } else if (tag == 21 || tag == 22) {
obj->mode = 1; obj->mode = 1;
if (tag == 22) { if (tag == 22) {
obj->vis = 2; obj->vis = 2;
} }
OPT_InStruct(&obj->typ); OPT_InStruct(&obj->typ);
} else {
OPM_LogWStr((CHAR*)"ERROR: Unexpected tag in InObj: ", 33);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return NIL;
} }
OPT_InName((void*)obj->name, 256); OPT_InName((void*)obj->name, 256);
} }
if ((hasComment && obj != NIL)) {
obj->comment = __NEWARR(NIL, 1, 1, 1, 0, 256);
j = 0;
while ((((j < 255 && j < len)) && commentText[__X(j, 256)] != 0x00)) {
(*obj->comment)[__X(j, 256)] = commentText[__X(j, 256)];
j += 1;
}
(*obj->comment)[__X(j, 256)] = 0x00;
}
OPT_FPrintObj(obj); OPT_FPrintObj(obj);
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) { if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255); OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
@ -1752,7 +1824,7 @@ static void OPT_OutConstant (OPT_Object obj)
OPM_SymWInt(f); OPM_SymWInt(f);
switch (f) { switch (f) {
case 2: case 3: case 2: case 3:
OPM_SymWCh((CHAR)obj->conval->intval); OPM_SymWCh(__CHR(obj->conval->intval));
break; break;
case 4: case 4:
OPM_SymWInt(obj->conval->intval); OPM_SymWInt(obj->conval->intval);
@ -1780,13 +1852,40 @@ static void OPT_OutConstant (OPT_Object obj)
} }
} }
static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len)
{
INT16 i;
__DUP(text, text__len, CHAR);
i = 0;
while ((i < 255 && text[__X(i, text__len)] != 0x00)) {
OPM_SymWCh(text[__X(i, text__len)]);
i += 1;
}
OPM_SymWCh(0x00);
__DEL(text);
}
static void OPT_OutObj (OPT_Object obj) static void OPT_OutObj (OPT_Object obj)
{ {
INT16 i, j; INT16 i, j;
OPT_ConstExt ext = NIL; OPT_ConstExt ext = NIL;
INT16 k, l;
if (obj != NIL) { if (obj != NIL) {
OPT_OutObj(obj->left); OPT_OutObj(obj->left);
if (__IN(obj->mode, 0x06ea, 32)) { if (__IN(obj->mode, 0x06ea, 32)) {
if (obj->comment != NIL) {
OPM_SymWInt(41);
k = 0;
while ((k < 255 && (*obj->comment)[__X(k, 256)] != 0x00)) {
k += 1;
}
OPM_SymWInt(k);
l = 0;
while (l < k) {
OPM_SymWCh((*obj->comment)[__X(l, 256)]);
l += 1;
}
}
if (obj->history == 4) { if (obj->history == 4) {
OPT_FPrintErr(obj, 250); OPT_FPrintErr(obj, 250);
} else if (obj->vis != 0) { } else if (obj->vis != 0) {
@ -2026,7 +2125,7 @@ static void EnumPtrs(void (*P)(void*))
} }
__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -8}}; __TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -8}};
__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}}; __TDESC(OPT_ObjDesc, 1, 7) = {__TDFLDS("ObjDesc", 308), {0, 4, 8, 12, 284, 288, 304, -32}};
__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 56), {44, 48, 52, -16}}; __TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 56), {44, 48, 52, -16}};
__TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 28), {0, 4, 8, 16, 20, 24, -28}}; __TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 28), {0, 4, 8, 16, 20, 24, -28}};
__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76, __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76,

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPT__h #ifndef OPT__h
#define OPT__h #define OPT__h
@ -61,6 +61,7 @@ typedef
OPT_Const conval; OPT_Const conval;
INT32 adr, linkadr; INT32 adr, linkadr;
INT16 x; INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc; } OPT_ObjDesc;
typedef typedef

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -112,7 +112,7 @@ static void OPV_Stamp (OPS_Name s)
i += 2; i += 2;
k = 0; k = 0;
do { do {
n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48); n[__X(k, 10)] = __CHR((int)__MOD(j, 10) + 48);
j = __DIV(j, 10); j = __DIV(j, 10);
k += 1; k += 1;
} while (!(j == 0)); } while (!(j == 0));
@ -317,15 +317,27 @@ static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp
static void OPV_Len (OPT_Node n, INT64 dim) static void OPV_Len (OPT_Node n, INT64 dim)
{ {
INT64 d;
OPT_Struct array = NIL;
while ((n->class == 4 && n->typ->comp == 3)) { while ((n->class == 4 && n->typ->comp == 3)) {
dim += 1; dim += 1;
n = n->left; n = n->left;
} }
if ((n->class == 3 && n->typ->comp == 3)) { if ((n->class == 3 && n->typ->comp == 3)) {
OPV_design(n->left, 10); d = dim;
OPM_WriteString((CHAR*)"->len[", 7); array = n->typ;
OPM_WriteInt(dim); while (d > 0) {
OPM_Write(']'); array = array->BaseTyp;
d -= 1;
}
if (array->comp == 3) {
OPV_design(n->left, 10);
OPM_WriteString((CHAR*)"->len[", 7);
OPM_WriteInt(dim);
OPM_Write(']');
} else {
OPM_WriteInt(array->n);
}
} else { } else {
OPC_Len(n->obj, n->typ, dim); OPC_Len(n->obj, n->typ, dim);
} }
@ -370,6 +382,7 @@ static void OPV_SizeCast (OPT_Node n, INT32 to)
OPM_WriteInt(__ASHL(to, 3)); OPM_WriteInt(__ASHL(to, 3));
OPM_WriteString((CHAR*)")", 2); OPM_WriteString((CHAR*)")", 2);
} }
OPV_Entier(n, 9);
} }
} }
@ -381,7 +394,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec)
if (to == 7) { if (to == 7) {
if (from == 7) { if (from == 7) {
OPV_SizeCast(n, newtype->size); OPV_SizeCast(n, newtype->size);
OPV_Entier(n, 9);
} else { } else {
OPM_WriteString((CHAR*)"__SETOF(", 9); OPM_WriteString((CHAR*)"__SETOF(", 9);
OPV_Entier(n, -1); OPV_Entier(n, -1);
@ -391,7 +403,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec)
} }
} else if (to == 4) { } else if (to == 4) {
OPV_SizeCast(n, newtype->size); OPV_SizeCast(n, newtype->size);
OPV_Entier(n, 9);
} else if (to == 3) { } else if (to == 3) {
if (__IN(2, OPM_Options, 32)) { if (__IN(2, OPM_Options, 32)) {
OPM_WriteString((CHAR*)"__CHR", 6); OPM_WriteString((CHAR*)"__CHR", 6);
@ -1183,7 +1194,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
base = base->BaseTyp; base = base->BaseTyp;
} }
if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) {
OPC_Ident(base->strobj); OPC_Andent(base);
OPM_WriteString((CHAR*)"__typ", 6); OPM_WriteString((CHAR*)"__typ", 6);
} else if (base->form == 11) { } else if (base->form == 11) {
OPM_WriteString((CHAR*)"POINTER__typ", 13); OPM_WriteString((CHAR*)"POINTER__typ", 13);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPV__h #ifndef OPV__h
#define OPV__h #define OPV__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -80,7 +80,7 @@ void Out_String (CHAR *str, ADDRESS str__len)
error = Platform_Write(1, (ADDRESS)str, l); error = Platform_Write(1, (ADDRESS)str, l);
} else { } else {
__MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l); __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l);
Out_in += (INT16)l; Out_in += __SHORT(l, 32768);
} }
__DEL(str); __DEL(str);
} }
@ -98,11 +98,11 @@ void Out_Int (INT64 x, INT64 n)
if (x < 0) { if (x < 0) {
x = -x; x = -x;
} }
s[0] = (CHAR)(48 + __MOD(x, 10)); s[0] = __CHR(48 + __MOD(x, 10));
x = __DIV(x, 10); x = __DIV(x, 10);
i = 1; i = 1;
while (x != 0) { while (x != 0) {
s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10)); s[__X(i, 22)] = __CHR(48 + __MOD(x, 10));
x = __DIV(x, 10); x = __DIV(x, 10);
i += 1; i += 1;
} }
@ -138,9 +138,9 @@ void Out_Hex (INT64 x, INT64 n)
x = __ROTL(x, 4, 64); x = __ROTL(x, 4, 64);
n -= 1; n -= 1;
if (__MASK(x, -16) < 10) { if (__MASK(x, -16) < 10) {
Out_Char((CHAR)(__MASK(x, -16) + 48)); Out_Char(__CHR(__MASK(x, -16) + 48));
} else { } else {
Out_Char((CHAR)((__MASK(x, -16) - 10) + 65)); Out_Char(__CHR((__MASK(x, -16) - 10) + 65));
} }
} }
} }
@ -154,7 +154,7 @@ void Out_Ln (void)
static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i) static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i)
{ {
*i -= 1; *i -= 1;
s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48); s[__X(*i, s__len)] = __CHR(__MOD(n, 10) + 48);
} }
static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i) static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i)
@ -166,7 +166,7 @@ static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16
if (l > *i) { if (l > *i) {
l = *i; l = *i;
} }
*i -= (INT16)l; *i -= __SHORT(l, 32768);
j = 0; j = 0;
while (j < l) { while (j < l) {
s[__X(*i + j, s__len)] = t[__X(j, t__len)]; s[__X(*i + j, s__len)] = t[__X(j, t__len)];
@ -248,7 +248,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
if (nn) { if (nn) {
x = -x; x = -x;
} }
e = (INT16)__ASHR((e - 1023) * 77, 8); e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
if (e >= 0) { if (e >= 0) {
x = x / (LONGREAL)Out_Ten(e); x = x / (LONGREAL)Out_Ten(e);
} else { } else {

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Out__h #ifndef Out__h
#define Out__h #define Out__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -42,6 +42,8 @@ export BOOLEAN Platform_Inaccessible (INT16 e);
export BOOLEAN Platform_Interrupted (INT16 e); export BOOLEAN Platform_Interrupted (INT16 e);
export BOOLEAN Platform_IsConsole (INT32 h); export BOOLEAN Platform_IsConsole (INT32 h);
export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
export INT16 Platform_MaxNameLength (void);
export INT16 Platform_MaxPathLength (void);
export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
export BOOLEAN Platform_NoSuchDirectory (INT16 e); export BOOLEAN Platform_NoSuchDirectory (INT16 e);
export INT32 Platform_OSAllocate (INT32 size); export INT32 Platform_OSAllocate (INT32 size);
@ -79,6 +81,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS
#include <sys/types.h> #include <sys/types.h>
#include <time.h> #include <time.h>
#include <unistd.h> #include <unistd.h>
#include <limits.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#define Platform_EACCES() EACCES #define Platform_EACCES() EACCES
@ -94,6 +97,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS
#define Platform_EROFS() EROFS #define Platform_EROFS() EROFS
#define Platform_ETIMEDOUT() ETIMEDOUT #define Platform_ETIMEDOUT() ETIMEDOUT
#define Platform_EXDEV() EXDEV #define Platform_EXDEV() EXDEV
#define Platform_NAMEMAX() NAME_MAX
#define Platform_PATHMAX() PATH_MAX
#define Platform_allocate(size) (ADDRESS)((void*)malloc((size_t)size)) #define Platform_allocate(size) (ADDRESS)((void*)malloc((size_t)size))
#define Platform_chdir(n, n__len) chdir((char*)n) #define Platform_chdir(n, n__len) chdir((char*)n)
#define Platform_closefile(fd) close(fd) #define Platform_closefile(fd) close(fd)
@ -178,6 +183,16 @@ BOOLEAN Platform_Interrupted (INT16 e)
return e == Platform_EINTR(); return e == Platform_EINTR();
} }
INT16 Platform_MaxNameLength (void)
{
return Platform_NAMEMAX();
}
INT16 Platform_MaxPathLength (void)
{
return Platform_PATHMAX();
}
INT32 Platform_OSAllocate (INT32 size) INT32 Platform_OSAllocate (INT32 size)
{ {
return Platform_allocate(size); return Platform_allocate(size);
@ -189,13 +204,13 @@ void Platform_OSFree (INT32 address)
} }
typedef typedef
CHAR (*EnvPtr__78)[1024]; CHAR (*EnvPtr__83)[1024];
BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len) BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{ {
EnvPtr__78 p = NIL; EnvPtr__83 p = NIL;
__DUP(var, var__len, CHAR); __DUP(var, var__len, CHAR);
p = (EnvPtr__78)(ADDRESS)Platform_getenv(var, var__len); p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
if (p != NIL) { if (p != NIL) {
__COPY(*p, val, val__len); __COPY(*p, val, val__len);
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Platform__h #ifndef Platform__h
#define Platform__h #define Platform__h
@ -40,6 +40,8 @@ import BOOLEAN Platform_Inaccessible (INT16 e);
import BOOLEAN Platform_Interrupted (INT16 e); import BOOLEAN Platform_Interrupted (INT16 e);
import BOOLEAN Platform_IsConsole (INT32 h); import BOOLEAN Platform_IsConsole (INT32 h);
import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
import INT16 Platform_MaxNameLength (void);
import INT16 Platform_MaxPathLength (void);
import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
import BOOLEAN Platform_NoSuchDirectory (INT16 e); import BOOLEAN Platform_NoSuchDirectory (INT16 e);
import INT32 Platform_OSAllocate (INT32 size); import INT32 Platform_OSAllocate (INT32 size);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -67,9 +67,9 @@ void Reals_SetExpo (REAL *x, INT16 ex)
{ {
CHAR c; CHAR c;
__GET((ADDRESS)x + 3, c, CHAR); __GET((ADDRESS)x + 3, c, CHAR);
__PUT((ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); __PUT((ADDRESS)x + 3, __CHR(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
__GET((ADDRESS)x + 2, c, CHAR); __GET((ADDRESS)x + 2, c, CHAR);
__PUT((ADDRESS)x + 2, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); __PUT((ADDRESS)x + 2, __CHR(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
} }
INT16 Reals_ExpoL (LONGREAL x) INT16 Reals_ExpoL (LONGREAL x)
@ -87,21 +87,21 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len)
} }
k = 0; k = 0;
if (n > 9) { if (n > 9) {
i = (INT32)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000); i = __SHORT(__ENTIER(x / (LONGREAL)(LONGREAL)1000000000), 2147483648LL);
j = (INT32)__ENTIER(x - i * (LONGREAL)1000000000); j = __SHORT(__ENTIER(x - i * (LONGREAL)1000000000), 2147483648LL);
if (j < 0) { if (j < 0) {
j = 0; j = 0;
} }
while (k < 9) { while (k < 9) {
d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48); d[__X(k, d__len)] = __CHR((int)__MOD(j, 10) + 48);
j = __DIV(j, 10); j = __DIV(j, 10);
k += 1; k += 1;
} }
} else { } else {
i = (INT32)__ENTIER(x); i = __SHORT(__ENTIER(x), 2147483648LL);
} }
while (k < n) { while (k < n) {
d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48); d[__X(k, d__len)] = __CHR((int)__MOD(i, 10) + 48);
i = __DIV(i, 10); i = __DIV(i, 10);
k += 1; k += 1;
} }
@ -115,9 +115,9 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
static CHAR Reals_ToHex (INT16 i) static CHAR Reals_ToHex (INT16 i)
{ {
if (i < 10) { if (i < 10) {
return (CHAR)(i + 48); return __CHR(i + 48);
} else { } else {
return (CHAR)(i + 55); return __CHR(i + 55);
} }
__RETCHK; __RETCHK;
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Reals__h #ifndef Reals__h
#define Reals__h #define Reals__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -6,6 +6,7 @@
#define SET UINT32 #define SET UINT32
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Reals.h"
@ -19,6 +20,8 @@ export INT16 Strings_Length (CHAR *s, ADDRESS s__len);
export BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); export BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len);
export INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); export INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos);
export void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); export void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
export void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r);
export void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r);
INT16 Strings_Length (CHAR *s, ADDRESS s__len) INT16 Strings_Length (CHAR *s, ADDRESS s__len)
@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len)
} }
if (i <= 32767) { if (i <= 32767) {
__DEL(s); __DEL(s);
return (INT16)i; return __SHORT(i, 32768);
} else { } else {
__DEL(s); __DEL(s);
return 32767; return 32767;
@ -123,7 +126,7 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA
INT16 len, destLen, i; INT16 len, destLen, i;
__DUP(source, source__len, CHAR); __DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len); len = Strings_Length(source, source__len);
destLen = (INT16)dest__len - 1; destLen = __SHORT(dest__len, 32768) - 1;
if (pos < 0) { if (pos < 0) {
pos = 0; pos = 0;
} }
@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS
return __retval; return __retval;
} }
void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r)
{
INT16 p, e;
REAL y, g;
BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
if (s[__X(p, s__len)] == '-') {
neg = 1;
p += 1;
} else {
neg = 0;
}
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
y = (REAL)0;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
y = y * (REAL)10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (s[__X(p, s__len)] == '.') {
p += 1;
g = (REAL)1;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
g = g / (REAL)(REAL)10;
y = y + g * ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
}
if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') {
p += 1;
e = 0;
if (s[__X(p, s__len)] == '-') {
negE = 1;
p += 1;
} else {
negE = 0;
}
while (s[__X(p, s__len)] == '0') {
p += 1;
}
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
e = e * 10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (negE) {
y = y / (REAL)Reals_Ten(e);
} else {
y = y * Reals_Ten(e);
}
}
if (neg) {
y = -y;
}
*r = y;
__DEL(s);
}
void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r)
{
INT16 p, e;
LONGREAL y, g;
BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
if (s[__X(p, s__len)] == '-') {
neg = 1;
p += 1;
} else {
neg = 0;
}
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
y = (LONGREAL)0;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
y = y * (LONGREAL)10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (s[__X(p, s__len)] == '.') {
p += 1;
g = (LONGREAL)1;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
g = g / (LONGREAL)(LONGREAL)10;
y = y + g * ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
}
if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') {
p += 1;
e = 0;
if (s[__X(p, s__len)] == '-') {
negE = 1;
p += 1;
} else {
negE = 0;
}
while (s[__X(p, s__len)] == '0') {
p += 1;
}
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
e = e * 10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (negE) {
y = y / (LONGREAL)Reals_Ten(e);
} else {
y = y * Reals_Ten(e);
}
}
if (neg) {
y = -y;
}
*r = y;
__DEL(s);
}
export void *Strings__init(void) export void *Strings__init(void)
{ {
__DEFMOD; __DEFMOD;
__MODULE_IMPORT(Reals);
__REGMOD("Strings", 0); __REGMOD("Strings", 0);
/* BEGIN */ /* BEGIN */
__ENDMOD; __ENDMOD;

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Strings__h #ifndef Strings__h
#define Strings__h #define Strings__h
@ -17,6 +17,8 @@ import INT16 Strings_Length (CHAR *s, ADDRESS s__len);
import BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); import BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len);
import INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); import INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos);
import void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); import void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
import void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r);
import void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r);
import void *Strings__init(void); import void *Strings__init(void);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -8,7 +8,6 @@
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Files.h" #include "Files.h"
#include "Modules.h" #include "Modules.h"
#include "Out.h"
#include "Reals.h" #include "Reals.h"
typedef typedef
@ -813,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ)
if ('9' < ch) { if ('9' < ch) {
if (('A' <= ch && ch <= 'F')) { if (('A' <= ch && ch <= 'F')) {
hex = 1; hex = 1;
ch = (CHAR)((INT16)ch - 7); ch = __CHR((INT16)ch - 7);
} else if (('a' <= ch && ch <= 'f')) { } else if (('a' <= ch && ch <= 'f')) {
hex = 1; hex = 1;
ch = (CHAR)((INT16)ch - 39); ch = __CHR((INT16)ch - 39);
} else { } else {
break; break;
} }
@ -1058,7 +1057,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
x0 = x; x0 = x;
} }
do { do {
a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48); a[__X(i, 24)] = __CHR(__MOD(x0, 10) + 48);
x0 = __DIV(x0, 10); x0 = __DIV(x0, 10);
i += 1; i += 1;
} while (!(x0 == 0)); } while (!(x0 == 0));
@ -1085,9 +1084,9 @@ void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x)
do { do {
y = __MASK(x, -16); y = __MASK(x, -16);
if (y < 10) { if (y < 10) {
a[__X(i, 20)] = (CHAR)(y + 48); a[__X(i, 20)] = __CHR(y + 48);
} else { } else {
a[__X(i, 20)] = (CHAR)(y + 55); a[__X(i, 20)] = __CHR(y + 55);
} }
x = __ASHR(x, 4); x = __ASHR(x, 4);
i += 1; i += 1;
@ -1163,8 +1162,8 @@ void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n)
} else { } else {
Texts_Write(&*W, W__typ, '+'); Texts_Write(&*W, W__typ, '+');
} }
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
} }
} }
@ -1314,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
} else { } else {
Texts_Write(&*W, W__typ, ' '); Texts_Write(&*W, W__typ, ' ');
} }
e = (INT16)__ASHR((e - 1023) * 77, 8); e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
if (e >= 0) { if (e >= 0) {
x = x / (LONGREAL)Reals_TenL(e); x = x / (LONGREAL)Reals_TenL(e);
} else { } else {
@ -1345,10 +1344,10 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
} else { } else {
Texts_Write(&*W, W__typ, '+'); Texts_Write(&*W, W__typ, '+');
} }
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); Texts_Write(&*W, W__typ, __CHR(__DIV(e, 100) + 48));
e = (int)__MOD(e, 100); e = (int)__MOD(e, 100);
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
} }
} }
@ -1375,8 +1374,8 @@ static void WritePair__44 (CHAR ch, INT32 x);
static void WritePair__44 (CHAR ch, INT32 x) static void WritePair__44 (CHAR ch, INT32 x)
{ {
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch); Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch);
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48)); Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR(__DIV(x, 10) + 48));
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)((int)__MOD(x, 10) + 48)); Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR((int)__MOD(x, 10) + 48));
} }
void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d) void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d)
@ -1810,7 +1809,6 @@ export void *Texts__init(void)
__DEFMOD; __DEFMOD;
__MODULE_IMPORT(Files); __MODULE_IMPORT(Files);
__MODULE_IMPORT(Modules); __MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Reals); __MODULE_IMPORT(Reals);
__REGMOD("Texts", EnumPtrs); __REGMOD("Texts", EnumPtrs);
__INITYP(Texts_FontDesc, Texts_FontDesc, 0); __INITYP(Texts_FontDesc, Texts_FontDesc, 0);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Texts__h #ifndef Texts__h
#define Texts__h #define Texts__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -34,6 +34,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len);
export void VT100_HVP (INT16 n, INT16 m); export void VT100_HVP (INT16 n, INT16 m);
export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
export void VT100_RCP (void); export void VT100_RCP (void);
export void VT100_Reset (void);
static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end); static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end);
export void VT100_SCP (void); export void VT100_SCP (void);
export void VT100_SD (INT16 n); export void VT100_SD (INT16 n);
@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
} }
e = s; e = s;
do { do {
b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48); b[__X(e, 21)] = __CHR((int)__MOD(int_, 10) + 48);
int_ = __DIV(int_, 10); int_ = __DIV(int_, 10);
e += 1; e += 1;
} while (!(int_ == 0)); } while (!(int_ == 0));
@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
__DEL(letter); __DEL(letter);
} }
void VT100_Reset (void)
{
CHAR cmd[6];
__COPY("\033", cmd, 6);
Strings_Append((CHAR*)"c", 2, (void*)cmd, 6);
Out_String(cmd, 6);
Out_Ln();
}
void VT100_CUU (INT16 n) void VT100_CUU (INT16 n)
{ {
VT100_EscSeq(n, (CHAR*)"A", 2); VT100_EscSeq(n, (CHAR*)"A", 2);
@ -256,6 +266,7 @@ export void *VT100__init(void)
__REGCMD("DECTCEMh", VT100_DECTCEMh); __REGCMD("DECTCEMh", VT100_DECTCEMh);
__REGCMD("DECTCEMl", VT100_DECTCEMl); __REGCMD("DECTCEMl", VT100_DECTCEMl);
__REGCMD("RCP", VT100_RCP); __REGCMD("RCP", VT100_RCP);
__REGCMD("Reset", VT100_Reset);
__REGCMD("SCP", VT100_SCP); __REGCMD("SCP", VT100_SCP);
/* BEGIN */ /* BEGIN */
__COPY("\033", VT100_CSI, 5); __COPY("\033", VT100_CSI, 5);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef VT100__h #ifndef VT100__h
#define VT100__h #define VT100__h
@ -25,6 +25,7 @@ import void VT100_EL (INT16 n);
import void VT100_HVP (INT16 n, INT16 m); import void VT100_HVP (INT16 n, INT16 m);
import void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); import void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
import void VT100_RCP (void); import void VT100_RCP (void);
import void VT100_Reset (void);
import void VT100_SCP (void); import void VT100_SCP (void);
import void VT100_SD (INT16 n); import void VT100_SD (INT16 n);
import void VT100_SGR (INT16 n); import void VT100_SGR (INT16 n);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -7,18 +7,22 @@
#include "SYSTEM.h" #include "SYSTEM.h"
#include "Configuration.h" #include "Configuration.h"
#include "Heap.h"
#include "Modules.h" #include "Modules.h"
#include "OPM.h" #include "OPM.h"
#include "Out.h" #include "Out.h"
#include "Platform.h" #include "Platform.h"
#include "Strings.h" #include "Strings.h"
typedef
CHAR extTools_CommandString[4096];
static CHAR extTools_CFLAGS[1023];
static extTools_CommandString extTools_CFLAGS;
export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len); export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len);
static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len); static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len);
export void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len); export void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len);
static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len); static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len);
@ -26,14 +30,17 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES
static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len) static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len)
{ {
INT16 r, status, exitcode; INT16 r, status, exitcode;
extTools_CommandString fullcmd;
__DUP(title, title__len, CHAR); __DUP(title, title__len, CHAR);
__DUP(cmd, cmd__len, CHAR); __DUP(cmd, cmd__len, CHAR);
if (__IN(18, OPM_Options, 32)) { if (__IN(18, OPM_Options, 32)) {
Out_String(title, title__len); Out_String((CHAR*)" ", 3);
Out_String(cmd, cmd__len); Out_String(cmd, cmd__len);
Out_Ln(); Out_Ln();
} }
r = Platform_System(cmd, cmd__len); __COPY(cmd, fullcmd, 4096);
Heap_GC(0);
r = Platform_System(fullcmd, 4096);
status = __MASK(r, -128); status = __MASK(r, -128);
exitcode = __ASHR(r, 8); exitcode = __ASHR(r, 8);
if (exitcode > 127) { if (exitcode > 127) {
@ -63,50 +70,55 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES
__DEL(cmd); __DEL(cmd);
} }
static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len) static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len)
{ {
__COPY("gcc -g", s, s__len); __DUP(additionalopts, additionalopts__len, CHAR);
__COPY("gcc -fPIC -g -Wno-stringop-overflow", s, s__len);
Strings_Append((CHAR*)" -I \"", 6, (void*)s, s__len); Strings_Append((CHAR*)" -I \"", 6, (void*)s, s__len);
Strings_Append(OPM_ResourceDir, 1024, (void*)s, s__len); Strings_Append(OPM_ResourceDir, 1024, (void*)s, s__len);
Strings_Append((CHAR*)"/include\" ", 11, (void*)s, s__len); Strings_Append((CHAR*)"/include\" ", 11, (void*)s, s__len);
Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 1023); Strings_Append(additionalopts, additionalopts__len, (void*)s, s__len);
Strings_Append(extTools_CFLAGS, 1023, (void*)s, s__len);
Strings_Append((CHAR*)" ", 2, (void*)s, s__len); Strings_Append((CHAR*)" ", 2, (void*)s, s__len);
Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 4096);
Strings_Append(extTools_CFLAGS, 4096, (void*)s, s__len);
Strings_Append((CHAR*)" ", 2, (void*)s, s__len);
__DEL(additionalopts);
} }
void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len) void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len)
{ {
CHAR cmd[1023]; extTools_CommandString cmd;
__DUP(moduleName, moduleName__len, CHAR); __DUP(moduleName, moduleName__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 1023); extTools_InitialiseCompilerCommand((void*)cmd, 4096, (CHAR*)"", 1);
Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 1023); Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c", 3, (void*)cmd, 1023); Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096);
extTools_execute((CHAR*)"C compile: ", 12, cmd, 1023); extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096);
__DEL(moduleName); __DEL(moduleName);
} }
void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len) void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len)
{ {
CHAR cmd[1023]; extTools_CommandString cmd;
__DUP(additionalopts, additionalopts__len, CHAR); __DUP(additionalopts, additionalopts__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 1023); extTools_InitialiseCompilerCommand((void*)cmd, 4096, additionalopts, additionalopts__len);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c ", 4, (void*)cmd, 1023); Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096);
Strings_Append(additionalopts, additionalopts__len, (void*)cmd, 1023);
if (statically) { if (statically) {
Strings_Append((CHAR*)" -static", 9, (void*)cmd, 1023); Strings_Append((CHAR*)" -static", 9, (void*)cmd, 4096);
} }
Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 1023); Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 1023); if (!statically || 1) {
Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 1023); Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 4096);
Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 1023); Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 4096);
Strings_Append((CHAR*)" -l voc", 8, (void*)cmd, 1023); Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 4096);
Strings_Append((CHAR*)"-O", 3, (void*)cmd, 1023); Strings_Append((CHAR*)" -lvoc", 7, (void*)cmd, 4096);
Strings_Append(OPM_Model, 10, (void*)cmd, 1023); Strings_Append((CHAR*)"-O", 3, (void*)cmd, 4096);
Strings_Append((CHAR*)"", 1, (void*)cmd, 1023); Strings_Append(OPM_Model, 10, (void*)cmd, 4096);
extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 1023); Strings_Append((CHAR*)"", 1, (void*)cmd, 4096);
}
extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096);
__DEL(additionalopts); __DEL(additionalopts);
} }
@ -115,6 +127,7 @@ export void *extTools__init(void)
{ {
__DEFMOD; __DEFMOD;
__MODULE_IMPORT(Configuration); __MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Modules); __MODULE_IMPORT(Modules);
__MODULE_IMPORT(OPM); __MODULE_IMPORT(OPM);
__MODULE_IMPORT(Out); __MODULE_IMPORT(Out);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef extTools__h #ifndef extTools__h
#define extTools__h #define extTools__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -89,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp; OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp; OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp; OPT_lintobj->typ = OPT_linttyp;
switch (OPM_LongintSize) { switch (OPM_SetSize) {
case 4: case 4:
OPT_settyp = OPT_set32typ; OPT_settyp = OPT_set32typ;
break; break;

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -8,7 +8,7 @@
#include "SYSTEM.h" #include "SYSTEM.h"
export CHAR Configuration_versionLong[75]; export CHAR Configuration_versionLong[76];
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD; __DEFMOD;
__REGMOD("Configuration", 0); __REGMOD("Configuration", 0);
/* BEGIN */ /* BEGIN */
__MOVE("2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); __MOVE("2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76);
__ENDMOD; __ENDMOD;
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Configuration__h #ifndef Configuration__h
#define Configuration__h #define Configuration__h
@ -6,7 +6,7 @@
#include "SYSTEM.h" #include "SYSTEM.h"
import CHAR Configuration_versionLong[75]; import CHAR Configuration_versionLong[76];
import void *Configuration__init(void); import void *Configuration__init(void);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -26,7 +26,7 @@ typedef
Files_BufDesc *Files_Buffer; Files_BufDesc *Files_Buffer;
typedef typedef
CHAR Files_FileName[101]; CHAR Files_FileName[256];
typedef typedef
struct Files_FileDesc { struct Files_FileDesc {
@ -48,6 +48,7 @@ typedef
} Files_Rider; } Files_Rider;
export INT16 Files_MaxPathLength, Files_MaxNameLength;
static Files_FileDesc *Files_files; static Files_FileDesc *Files_files;
static INT16 Files_tempno; static INT16 Files_tempno;
static CHAR Files_HOME[1024]; static CHAR Files_HOME[1024];
@ -85,6 +86,7 @@ export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f); export void Files_Purge (Files_File f);
export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
export void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
@ -129,17 +131,17 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
Out_String((CHAR*)": ", 3); Out_String((CHAR*)": ", 3);
if (f != NIL) { if (f != NIL) {
if (f->registerName[0] != 0x00) { if (f->registerName[0] != 0x00) {
Out_String(f->registerName, 101); Out_String(f->registerName, 256);
} else { } else {
Out_String(f->workName, 101); Out_String(f->workName, 256);
} }
if (f->fd != 0) { if (f->fd != 0) {
Out_String((CHAR*)"f.fd = ", 8); Out_String((CHAR*)", f.fd = ", 10);
Out_Int(f->fd, 1); Out_Int(f->fd, 1);
} }
} }
if (errcode != 0) { if (errcode != 0) {
Out_String((CHAR*)" errcode = ", 12); Out_String((CHAR*)", errcode = ", 13);
Out_Int(errcode, 1); Out_Int(errcode, 1);
} }
Out_Ln(); Out_Ln();
@ -149,76 +151,75 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len) static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len)
{ {
INT16 i, j; INT16 i, j, ld, ln;
__DUP(dir, dir__len, CHAR); __DUP(dir, dir__len, CHAR);
__DUP(name, name__len, CHAR); __DUP(name, name__len, CHAR);
ld = Strings_Length(dir, dir__len);
ln = Strings_Length(name, name__len);
while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) {
ld -= 1;
}
if (((ld + ln) + 2) > dest__len) {
Files_Err((CHAR*)"File name too long", 19, NIL, 0);
}
i = 0; i = 0;
while (i < ld) {
dest[__X(i, dest__len)] = dir[__X(i, dir__len)];
i += 1;
}
if (i > 0) {
dest[__X(i, dest__len)] = '/';
i += 1;
}
j = 0; j = 0;
while (dir[i] != 0x00) { while (j < ln) {
dest[i] = dir[i]; dest[__X(i, dest__len)] = name[__X(j, name__len)];
i += 1;
}
if (dest[i - 1] != '/') {
dest[i] = '/';
i += 1;
}
while (name[j] != 0x00) {
dest[i] = name[j];
i += 1; i += 1;
j += 1; j += 1;
} }
dest[i] = 0x00; dest[__X(i, dest__len)] = 0x00;
__DEL(dir); __DEL(dir);
__DEL(name); __DEL(name);
} }
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len) static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len)
{ {
INT32 n, i, j; INT16 i, n;
__DUP(finalName, finalName__len, CHAR); __DUP(finalName, finalName__len, CHAR);
Files_tempno += 1; if (finalName[0] == '/') {
n = Files_tempno; __COPY(finalName, name, name__len);
i = 0; } else {
if (finalName[0] != '/') { Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len);
while (Platform_CWD[i] != 0x00) {
name[i] = Platform_CWD[i];
i += 1;
}
if (Platform_CWD[i - 1] != '/') {
name[i] = '/';
i += 1;
}
} }
j = 0; i = Strings_Length(name, name__len) - 1;
while (finalName[j] != 0x00) { while ((i > 0 && name[__X(i, name__len)] != '/')) {
name[i] = finalName[j];
i += 1;
j += 1;
}
i -= 1;
while (name[i] != '/') {
i -= 1; i -= 1;
} }
name[i + 1] = '.'; if ((i + 16) >= name__len) {
name[i + 2] = 't'; Files_Err((CHAR*)"File name too long", 19, NIL, 0);
name[i + 3] = 'm'; }
name[i + 4] = 'p'; Files_tempno += 1;
name[i + 5] = '.'; n = Files_tempno;
name[__X(i + 1, name__len)] = '.';
name[__X(i + 2, name__len)] = 't';
name[__X(i + 3, name__len)] = 'm';
name[__X(i + 4, name__len)] = 'p';
name[__X(i + 5, name__len)] = '.';
i += 6; i += 6;
while (n > 0) { while (n > 0) {
name[i] = (CHAR)((int)__MOD(n, 10) + 48); name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
n = __DIV(n, 10); n = __DIV(n, 10);
i += 1; i += 1;
} }
name[i] = '.'; name[__X(i, name__len)] = '.';
i += 1; i += 1;
n = Platform_PID; n = Platform_PID;
while (n > 0) { while (n > 0) {
name[i] = (CHAR)((int)__MOD(n, 10) + 48); name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
n = __DIV(n, 10); n = __DIV(n, 10);
i += 1; i += 1;
} }
name[i] = 0x00; name[__X(i, name__len)] = 0x00;
__DEL(finalName); __DEL(finalName);
} }
@ -236,11 +237,11 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len)
if (osfile != NIL) { if (osfile != NIL) {
__ASSERT(!osfile->tempFile, 0); __ASSERT(!osfile->tempFile, 0);
__ASSERT(osfile->fd >= 0, 0); __ASSERT(osfile->fd >= 0, 0);
__MOVE(osfile->workName, osfile->registerName, 101); __MOVE(osfile->workName, osfile->registerName, 256);
Files_GetTempName(osfile->registerName, 101, (void*)osfile->workName, 101); Files_GetTempName(osfile->registerName, 256, (void*)osfile->workName, 256);
osfile->tempFile = 1; osfile->tempFile = 1;
osfile->state = 0; osfile->state = 0;
error = Platform_Rename((void*)osfile->registerName, 101, (void*)osfile->workName, 101); error = Platform_Rename((void*)osfile->registerName, 256, (void*)osfile->workName, 256);
if (error != 0) { if (error != 0) {
Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error); Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error);
} }
@ -256,17 +257,17 @@ static void Files_Create (Files_File f)
CHAR err[32]; CHAR err[32];
if (f->fd == -1) { if (f->fd == -1) {
if (f->state == 1) { if (f->state == 1) {
Files_GetTempName(f->registerName, 101, (void*)f->workName, 101); Files_GetTempName(f->registerName, 256, (void*)f->workName, 256);
f->tempFile = 1; f->tempFile = 1;
} else { } else {
__ASSERT(f->state == 2, 0); __ASSERT(f->state == 2, 0);
Files_Deregister(f->registerName, 101); Files_Deregister(f->registerName, 256);
__MOVE(f->registerName, f->workName, 101); __MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00; f->registerName[0] = 0x00;
f->tempFile = 0; f->tempFile = 0;
} }
error = Platform_Unlink((void*)f->workName, 101); error = Platform_Unlink((void*)f->workName, 256);
error = Platform_New((void*)f->workName, 101, &f->fd); error = Platform_New((void*)f->workName, 256, &f->fd);
done = error == 0; done = error == 0;
if (done) { if (done) {
f->next = Files_files; f->next = Files_files;
@ -319,8 +320,8 @@ void Files_Close (Files_File f)
if (f->state != 1 || f->registerName[0] != 0x00) { if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f); Files_Create(f);
i = 0; i = 0;
while ((i < 4 && f->bufs[i] != NIL)) { while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) {
Files_Flush(f->bufs[i]); Files_Flush(f->bufs[__X(i, 4)]);
i += 1; i += 1;
} }
} }
@ -337,7 +338,7 @@ Files_File Files_New (CHAR *name, ADDRESS name__len)
__DUP(name, name__len, CHAR); __DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc); __NEW(f, Files_FileDesc);
f->workName[0] = 0x00; f->workName[0] = 0x00;
__COPY(name, f->registerName, 101); __COPY(name, f->registerName, 256);
f->fd = -1; f->fd = -1;
f->state = 1; f->state = 1;
f->len = 0; f->len = 0;
@ -359,35 +360,35 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
*pos += 1; *pos += 1;
} }
} else { } else {
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (ch == ' ' || ch == ';') { while (ch == ' ' || ch == ';') {
*pos += 1; *pos += 1;
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
} }
if (ch == '~') { if (ch == '~') {
*pos += 1; *pos += 1;
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (Files_HOME[i] != 0x00) { while (Files_HOME[__X(i, 1024)] != 0x00) {
dir[i] = Files_HOME[i]; dir[__X(i, dir__len)] = Files_HOME[__X(i, 1024)];
i += 1; i += 1;
} }
if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) {
while ((i > 0 && dir[i - 1] != '/')) { while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) {
i -= 1; i -= 1;
} }
} }
} }
while ((ch != 0x00 && ch != ';')) { while ((ch != 0x00 && ch != ';')) {
dir[i] = ch; dir[__X(i, dir__len)] = ch;
i += 1; i += 1;
*pos += 1; *pos += 1;
ch = (Files_SearchPath->data)[*pos]; ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
} }
while ((i > 0 && dir[i - 1] == ' ')) { while ((i > 0 && dir[__X(i - 1, dir__len)] == ' ')) {
i -= 1; i -= 1;
} }
} }
dir[i] = 0x00; dir[__X(i, dir__len)] = 0x00;
} }
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
@ -398,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
ch = name[0]; ch = name[0];
while ((ch != 0x00 && ch != '/')) { while ((ch != 0x00 && ch != '/')) {
i += 1; i += 1;
ch = name[i]; ch = name[__X(i, name__len)];
} }
return ch == '/'; return ch == '/';
} }
@ -413,9 +414,9 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
if (!Platform_SameFileTime(identity, f->identity)) { if (!Platform_SameFileTime(identity, f->identity)) {
i = 0; i = 0;
while (i < 4) { while (i < 4) {
if (f->bufs[i] != NIL) { if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[i]->org = -1; f->bufs[__X(i, 4)]->org = -1;
f->bufs[i] = NIL; f->bufs[__X(i, 4)] = NIL;
} }
i += 1; i += 1;
} }
@ -482,7 +483,7 @@ Files_File Files_Old (CHAR *name, ADDRESS name__len)
f->pos = 0; f->pos = 0;
f->swapper = -1; f->swapper = -1;
error = Platform_Size(fd, &f->len); error = Platform_Size(fd, &f->len);
__COPY(name, f->workName, 101); __COPY(name, f->workName, 256);
f->registerName[0] = 0x00; f->registerName[0] = 0x00;
f->tempFile = 0; f->tempFile = 0;
f->identity = identity; f->identity = identity;
@ -514,9 +515,9 @@ void Files_Purge (Files_File f)
INT16 error; INT16 error;
i = 0; i = 0;
while (i < 4) { while (i < 4) {
if (f->bufs[i] != NIL) { if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[i]->org = -1; f->bufs[__X(i, 4)]->org = -1;
f->bufs[i] = NIL; f->bufs[__X(i, 4)] = NIL;
} }
i += 1; i += 1;
} }
@ -560,22 +561,22 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
offset = __MASK(pos, -4096); offset = __MASK(pos, -4096);
org = pos - offset; org = pos - offset;
i = 0; i = 0;
while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { while ((((i < 4 && f->bufs[__X(i, 4)] != NIL)) && org != f->bufs[__X(i, 4)]->org)) {
i += 1; i += 1;
} }
if (i < 4) { if (i < 4) {
if (f->bufs[i] == NIL) { if (f->bufs[__X(i, 4)] == NIL) {
__NEW(buf, Files_BufDesc); __NEW(buf, Files_BufDesc);
buf->chg = 0; buf->chg = 0;
buf->org = -1; buf->org = -1;
buf->f = f; buf->f = f;
f->bufs[i] = buf; f->bufs[__X(i, 4)] = buf;
} else { } else {
buf = f->bufs[i]; buf = f->bufs[__X(i, 4)];
} }
} else { } else {
f->swapper = __MASK(f->swapper + 1, -4); f->swapper = __MASK(f->swapper + 1, -4);
buf = f->bufs[f->swapper]; buf = f->bufs[__X(f->swapper, 4)];
Files_Flush(buf); Files_Flush(buf);
} }
if (buf->org != org) { if (buf->org != org) {
@ -622,7 +623,7 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
} }
Files_Assert(offset <= buf->size); Files_Assert(offset <= buf->size);
if (offset < buf->size) { if (offset < buf->size) {
*x = buf->data[offset]; *x = buf->data[__X(offset, 4096)];
(*r).offset = offset + 1; (*r).offset = offset + 1;
} else if ((*r).org + offset < buf->f->len) { } else if ((*r).org + offset < buf->f->len) {
Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset);
@ -634,6 +635,11 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
} }
} }
void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
{
Files_Read(&*r, r__typ, &*x);
}
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n) void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
{ {
INT32 xpos, min, restInBuf, offset; INT32 xpos, min, restInBuf, offset;
@ -660,7 +666,7 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x
} else { } else {
min = n; min = n;
} }
__MOVE((ADDRESS)&buf->data[offset], (ADDRESS)&x[xpos], min); __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
offset += min; offset += min;
(*r).offset = offset; (*r).offset = offset;
xpos += min; xpos += min;
@ -689,7 +695,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
offset = (*r).offset; offset = (*r).offset;
} }
Files_Assert(offset < 4096); Files_Assert(offset < 4096);
buf->data[offset] = x; buf->data[__X(offset, 4096)] = x;
buf->chg = 1; buf->chg = 1;
if (offset == buf->size) { if (offset == buf->size) {
buf->size += 1; buf->size += 1;
@ -723,7 +729,7 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS
} else { } else {
min = n; min = n;
} }
__MOVE((ADDRESS)&x[xpos], (ADDRESS)&buf->data[offset], min); __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
offset += min; offset += min;
(*r).offset = offset; (*r).offset = offset;
Files_Assert(offset <= 4096); Files_Assert(offset <= 4096);
@ -817,12 +823,12 @@ void Files_Register (Files_File f)
} }
Files_Close(f); Files_Close(f);
if (f->registerName[0] != 0x00) { if (f->registerName[0] != 0x00) {
Files_Deregister(f->registerName, 101); Files_Deregister(f->registerName, 256);
Files_Rename(f->workName, 101, f->registerName, 101, &errcode); Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
if (errcode != 0) { if (errcode != 0) {
Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode); Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
} }
__MOVE(f->registerName, f->workName, 101); __MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00; f->registerName[0] = 0x00;
f->tempFile = 0; f->tempFile = 0;
} }
@ -843,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *de
j = 0; j = 0;
while (i > 0) { while (i > 0) {
i -= 1; i -= 1;
dest[j] = src[i]; dest[__X(j, dest__len)] = src[__X(i, src__len)];
j += 1; j += 1;
} }
} else { } else {
@ -900,7 +906,7 @@ void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
i = 0; i = 0;
do { do {
Files_Read(&*R, R__typ, (void*)&ch); Files_Read(&*R, R__typ, (void*)&ch);
x[i] = ch; x[__X(i, x__len)] = ch;
i += 1; i += 1;
} while (!(ch == 0x00)); } while (!(ch == 0x00));
} }
@ -910,16 +916,16 @@ void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
INT16 i; INT16 i;
i = 0; i = 0;
do { do {
Files_Read(&*R, R__typ, (void*)&x[i]); Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]);
i += 1; i += 1;
} while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a)); } while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a));
if (x[i - 1] == 0x0a) { if (x[__X(i - 1, x__len)] == 0x0a) {
i -= 1; i -= 1;
} }
if ((i > 0 && x[i - 1] == 0x0d)) { if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) {
i -= 1; i -= 1;
} }
x[i] = 0x00; x[__X(i, x__len)] = 0x00;
} }
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len) void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
@ -947,18 +953,18 @@ void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x)
void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x) void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x)
{ {
CHAR b[2]; CHAR b[2];
b[0] = (CHAR)x; b[0] = __CHR(x);
b[1] = (CHAR)__ASHR(x, 8); b[1] = __CHR(__ASHR(x, 8));
Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2); Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2);
} }
void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x) void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x)
{ {
CHAR b[4]; CHAR b[4];
b[0] = (CHAR)x; b[0] = __CHR(x);
b[1] = (CHAR)__ASHR(x, 8); b[1] = __CHR(__ASHR(x, 8));
b[2] = (CHAR)__ASHR(x, 16); b[2] = __CHR(__ASHR(x, 16));
b[3] = (CHAR)__ASHR(x, 24); b[3] = __CHR(__ASHR(x, 24));
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
} }
@ -966,11 +972,13 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{ {
CHAR b[4]; CHAR b[4];
INT32 i; INT32 i;
i = (INT32)x; UINT64 y;
b[0] = (CHAR)i; y = x;
b[1] = (CHAR)__ASHR(i, 8); i = __VAL(INT32, y);
b[2] = (CHAR)__ASHR(i, 16); b[0] = __CHR(i);
b[3] = (CHAR)__ASHR(i, 24); b[1] = __CHR(__ASHR(i, 8));
b[2] = __CHR(__ASHR(i, 16));
b[3] = __CHR(__ASHR(i, 24));
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
} }
@ -992,7 +1000,7 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len
{ {
INT16 i; INT16 i;
i = 0; i = 0;
while (x[i] != 0x00) { while (x[__X(i, x__len)] != 0x00) {
i += 1; i += 1;
} }
Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1); Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
@ -1001,10 +1009,10 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len
void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x) void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{ {
while (x < -64 || x > 63) { while (x < -64 || x > 63) {
Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); Files_Write(&*R, R__typ, __CHR(__MASK(x, -128) + 128));
x = __ASHR(x, 7); x = __ASHR(x, 7);
} }
Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); Files_Write(&*R, R__typ, __CHR(__MASK(x, -128)));
} }
void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len) void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
@ -1041,7 +1049,7 @@ static void Files_Finalize (SYSTEM_PTR o)
if (f->fd >= 0) { if (f->fd >= 0) {
Files_CloseOSFile(f); Files_CloseOSFile(f);
if (f->tempFile) { if (f->tempFile) {
res = Platform_Unlink((void*)f->workName, 101); res = Platform_Unlink((void*)f->workName, 256);
} }
} }
} }
@ -1063,7 +1071,7 @@ static void EnumPtrs(void (*P)(void*))
P(Files_SearchPath); P(Files_SearchPath);
} }
__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 280), {232, 240, 248, 256, -40}}; __TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 592), {544, 552, 560, 568, -40}};
__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4120), {0, -16}}; __TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4120), {0, -16}};
__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 24), {8, -16}}; __TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 24), {8, -16}};
@ -1083,5 +1091,7 @@ export void *Files__init(void)
Heap_FileCount = 0; Heap_FileCount = 0;
Files_HOME[0] = 0x00; Files_HOME[0] = 0x00;
Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024); Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024);
Files_MaxPathLength = Platform_MaxPathLength();
Files_MaxNameLength = Platform_MaxNameLength();
__ENDMOD; __ENDMOD;
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Files__h #ifndef Files__h
#define Files__h #define Files__h
@ -11,7 +11,7 @@ typedef
typedef typedef
struct Files_FileDesc { struct Files_FileDesc {
INT64 _prvt0; INT64 _prvt0;
char _prvt1[272]; char _prvt1[584];
} Files_FileDesc; } Files_FileDesc;
typedef typedef
@ -23,6 +23,7 @@ typedef
} Files_Rider; } Files_Rider;
import INT16 Files_MaxPathLength, Files_MaxNameLength;
import ADDRESS *Files_FileDesc__typ; import ADDRESS *Files_FileDesc__typ;
import ADDRESS *Files_Rider__typ; import ADDRESS *Files_Rider__typ;
@ -40,6 +41,7 @@ import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
import void Files_Purge (Files_File f); import void Files_Purge (Files_File f);
import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
import void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -68,9 +68,10 @@ static INT64 Heap_freeList[10];
static INT64 Heap_bigBlocks; static INT64 Heap_bigBlocks;
export INT64 Heap_allocated; export INT64 Heap_allocated;
static BOOLEAN Heap_firstTry; static BOOLEAN Heap_firstTry;
static INT16 Heap_ldUnit;
export INT64 Heap_heap; export INT64 Heap_heap;
static INT64 Heap_heapMin, Heap_heapMax; static INT64 Heap_heapMin, Heap_heapMax;
export INT64 Heap_heapsize; export INT64 Heap_heapsize, Heap_heapMinExpand;
static Heap_FinNode Heap_fin; static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth; static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted; static BOOLEAN Heap_interrupted;
@ -228,10 +229,10 @@ static INT64 Heap_NewChunk (INT64 blksz)
static void Heap_ExtendHeap (INT64 blksz) static void Heap_ExtendHeap (INT64 blksz)
{ {
INT64 size, chnk, j, next; INT64 size, chnk, j, next;
if (Heap_uLT(320000, blksz)) { if (Heap_uLT(Heap_heapMinExpand, blksz)) {
size = blksz; size = blksz;
} else { } else {
size = 320000; size = Heap_heapMinExpand;
} }
chnk = Heap_NewChunk(size); chnk = Heap_NewChunk(size);
if (chnk != 0) { if (chnk != 0) {
@ -248,6 +249,8 @@ static void Heap_ExtendHeap (INT64 blksz)
__PUT(chnk, next, INT64); __PUT(chnk, next, INT64);
__PUT(j, chnk, INT64); __PUT(j, chnk, INT64);
} }
} else if (!Heap_firstTry) {
Heap_heapMinExpand = 32;
} }
} }
@ -257,16 +260,16 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
SYSTEM_PTR new; SYSTEM_PTR new;
Heap_Lock(); Heap_Lock();
__GET(tag, blksz, INT64); __GET(tag, blksz, INT64);
i0 = __ASHR(blksz, 5); i0 = __LSH(blksz, -Heap_ldUnit, 64);
i = i0; i = i0;
if (Heap_uLT(i, 9)) { if (i < 9) {
adr = Heap_freeList[i]; adr = Heap_freeList[i];
while (adr == 0) { while (adr == 0) {
i += 1; i += 1;
adr = Heap_freeList[i]; adr = Heap_freeList[i];
} }
} }
if (Heap_uLT(i, 9)) { if (i < 9) {
__GET(adr + 24, next, INT64); __GET(adr + 24, next, INT64);
Heap_freeList[i] = next; Heap_freeList[i] = next;
if (i != i0) { if (i != i0) {
@ -289,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
if (Heap_firstTry) { if (Heap_firstTry) {
Heap_GC(1); Heap_GC(1);
blksz += 32; blksz += 32;
if (Heap_uLT(Heap_heapsize - Heap_allocated, blksz) || Heap_uLT(__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2), Heap_heapsize)) { t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 64) * 160;
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize); if (Heap_uLT(Heap_heapsize, t)) {
Heap_ExtendHeap(t - Heap_heapsize);
} }
Heap_firstTry = 0; Heap_firstTry = 0;
new = Heap_NEWREC(tag); new = Heap_NEWREC(tag);
Heap_firstTry = 1;
if (new == NIL) { if (new == NIL) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize); Heap_ExtendHeap(blksz);
new = Heap_NEWREC(tag); new = Heap_NEWREC(tag);
} }
Heap_firstTry = 1;
Heap_Unlock(); Heap_Unlock();
return new; return new;
} else { } else {
@ -443,7 +447,7 @@ static void Heap_Scan (void)
__PUT(start, start + 8, INT64); __PUT(start, start + 8, INT64);
__PUT(start + 8, freesize, INT64); __PUT(start + 8, freesize, INT64);
__PUT(start + 16, -8, INT64); __PUT(start + 16, -8, INT64);
i = __ASHR(freesize, 5); i = __LSH(freesize, -Heap_ldUnit, 64);
freesize = 0; freesize = 0;
if (Heap_uLT(i, 9)) { if (Heap_uLT(i, 9)) {
__PUT(start + 24, Heap_freeList[i], INT64); __PUT(start + 24, Heap_freeList[i], INT64);
@ -469,7 +473,7 @@ static void Heap_Scan (void)
__PUT(start, start + 8, INT64); __PUT(start, start + 8, INT64);
__PUT(start + 8, freesize, INT64); __PUT(start + 8, freesize, INT64);
__PUT(start + 16, -8, INT64); __PUT(start + 16, -8, INT64);
i = __ASHR(freesize, 5); i = __LSH(freesize, -Heap_ldUnit, 64);
freesize = 0; freesize = 0;
if (Heap_uLT(i, 9)) { if (Heap_uLT(i, 9)) {
__PUT(start + 24, Heap_freeList[i], INT64); __PUT(start + 24, Heap_freeList[i], INT64);
@ -661,79 +665,77 @@ void Heap_GC (BOOLEAN markStack)
Heap_Module m; Heap_Module m;
INT64 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; INT64 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23;
INT64 cand[10000]; INT64 cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { Heap_Lock();
Heap_Lock(); m = (Heap_Module)(ADDRESS)Heap_modules;
m = (Heap_Module)(ADDRESS)Heap_modules; while (m != NIL) {
while (m != NIL) { if (m->enumPtrs != NIL) {
if (m->enumPtrs != NIL) { (*m->enumPtrs)(Heap_MarkP);
(*m->enumPtrs)(Heap_MarkP);
}
m = m->next;
} }
if (markStack) { m = m->next;
i0 = -100;
i1 = -101;
i2 = -102;
i3 = -103;
i4 = -104;
i5 = -105;
i6 = -106;
i7 = -107;
i8 = 1;
i9 = 2;
i10 = 3;
i11 = 4;
i12 = 5;
i13 = 6;
i14 = 7;
i15 = 8;
i16 = 9;
i17 = 10;
i18 = 11;
i19 = 12;
i20 = 13;
i21 = 14;
i22 = 15;
i23 = 16;
for (;;) {
i0 += 1;
i1 += 2;
i2 += 3;
i3 += 4;
i4 += 5;
i5 += 6;
i6 += 7;
i7 += 8;
i8 += 9;
i9 += 10;
i10 += 11;
i11 += 12;
i12 += 13;
i13 += 14;
i14 += 15;
i15 += 16;
i16 += 17;
i17 += 18;
i18 += 19;
i19 += 20;
i20 += 21;
i21 += 22;
i22 += 23;
i23 += 24;
if ((i0 == -99 && i15 == 24)) {
Heap_MarkStack(32, (void*)cand, 10000);
break;
}
}
if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) {
return;
}
}
Heap_CheckFin();
Heap_Scan();
Heap_Finalize();
Heap_Unlock();
} }
if (markStack) {
i0 = -100;
i1 = -101;
i2 = -102;
i3 = -103;
i4 = -104;
i5 = -105;
i6 = -106;
i7 = -107;
i8 = 1;
i9 = 2;
i10 = 3;
i11 = 4;
i12 = 5;
i13 = 6;
i14 = 7;
i15 = 8;
i16 = 9;
i17 = 10;
i18 = 11;
i19 = 12;
i20 = 13;
i21 = 14;
i22 = 15;
i23 = 16;
for (;;) {
i0 += 1;
i1 += 2;
i2 += 3;
i3 += 4;
i4 += 5;
i5 += 6;
i6 += 7;
i7 += 8;
i8 += 9;
i9 += 10;
i10 += 11;
i11 += 12;
i12 += 13;
i13 += 14;
i14 += 15;
i15 += 16;
i16 += 17;
i17 += 18;
i18 += 19;
i19 += 20;
i20 += 21;
i21 += 22;
i22 += 23;
i23 += 24;
if ((i0 == -99 && i15 == 24)) {
Heap_MarkStack(32, (void*)cand, 10000);
break;
}
}
if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) {
return;
}
}
Heap_CheckFin();
Heap_Scan();
Heap_Finalize();
Heap_Unlock();
} }
void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize) void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
@ -756,6 +758,8 @@ void Heap_InitHeap (void)
Heap_heapMin = -1; Heap_heapMin = -1;
Heap_heapMax = 0; Heap_heapMax = 0;
Heap_bigBlocks = 0; Heap_bigBlocks = 0;
Heap_heapMinExpand = 256000;
Heap_ldUnit = 5;
Heap_heap = Heap_NewChunk(256000); Heap_heap = Heap_NewChunk(256000);
__PUT(Heap_heap, 0, INT64); __PUT(Heap_heap, 0, INT64);
Heap_firstTry = 1; Heap_firstTry = 1;

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
#ifndef Heap__h #ifndef Heap__h
#define Heap__h #define Heap__h
@ -48,7 +48,7 @@ typedef
import SYSTEM_PTR Heap_modules; import SYSTEM_PTR Heap_modules;
import INT64 Heap_allocated; import INT64 Heap_allocated;
import INT64 Heap_heap; import INT64 Heap_heap;
import INT64 Heap_heapsize; import INT64 Heap_heapsize, Heap_heapMinExpand;
import INT16 Heap_FileCount; import INT16 Heap_FileCount;
import ADDRESS *Heap_ModuleDesc__typ; import ADDRESS *Heap_ModuleDesc__typ;

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -404,7 +404,7 @@ static void Modules_errint (INT32 l)
if (l >= 10) { if (l >= 10) {
Modules_errint(__DIV(l, 10)); Modules_errint(__DIV(l, 10));
} }
Modules_errch((CHAR)((int)__MOD(l, 10) + 48)); Modules_errch(__CHR((int)__MOD(l, 10) + 48));
} }
static void Modules_DisplayHaltCode (INT32 code) static void Modules_DisplayHaltCode (INT32 code)

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef Modules__h #ifndef Modules__h
#define Modules__h #define Modules__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -261,7 +261,7 @@ static void OPB_CharToString (OPT_Node n)
{ {
CHAR ch; CHAR ch;
n->typ = OPT_stringtyp; n->typ = OPT_stringtyp;
ch = (CHAR)n->conval->intval; ch = __CHR(n->conval->intval);
n->conval->ext = OPT_NewExt(); n->conval->ext = OPT_NewExt();
if (ch == 0x00) { if (ch == 0x00) {
n->conval->intval2 = 1; n->conval->intval2 = 1;
@ -597,7 +597,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
case 22: case 22:
if (f == 3) { if (f == 3) {
if (z->class == 7) { if (z->class == 7) {
z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval); z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval));
z->obj = NIL; z->obj = NIL;
} else { } else {
z = NewOp__29(op, typ, z); z = NewOp__29(op, typ, z);
@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203); OPB_err(203);
r = (LONGREAL)1; r = (LONGREAL)1;
} }
(*x)->conval->intval = (INT32)__ENTIER(r); (*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL);
OPB_SetIntType(*x); OPB_SetIntType(*x);
} }
} }
@ -1626,6 +1626,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
if (x == y) { if (x == y) {
} else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) { } else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) {
} else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) { } else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) {
OPB_err(113);
} else if (x->BaseTyp == OPT_chartyp) { } else if (x->BaseTyp == OPT_chartyp) {
if (g == 8) { if (g == 8) {
if (ynode->conval->intval2 > x->n) { if (ynode->conval->intval2 > x->n) {

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPB__h #ifndef OPB__h
#define OPB__h #define OPB__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -618,31 +618,33 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
{ {
if (obj != NIL) { if (obj != NIL) {
OPC_DefineTProcMacros(obj->left, &*empty); OPC_DefineTProcMacros(obj->left, &*empty);
if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) { if ((obj->mode == 13 && obj == OPC_BaseTProc(obj))) {
OPM_WriteString((CHAR*)"#define __", 11); if (OPM_currFile == 1 || (OPM_currFile == 0 && obj->vis == 1)) {
OPC_Ident(obj); OPM_WriteString((CHAR*)"#define __", 11);
OPC_DeclareParams(obj->link, 1); OPC_Ident(obj);
OPM_WriteString((CHAR*)" __SEND(", 9); OPC_DeclareParams(obj->link, 1);
if (obj->link->typ->form == 11) { OPM_WriteString((CHAR*)" __SEND(", 9);
OPM_WriteString((CHAR*)"__TYPEOF(", 10); if (obj->link->typ->form == 11) {
OPC_Ident(obj->link); OPM_WriteString((CHAR*)"__TYPEOF(", 10);
OPC_Ident(obj->link);
OPM_Write(')');
} else {
OPC_Ident(obj->link);
OPM_WriteString((CHAR*)"__typ", 6);
}
OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
if (obj->typ == OPT_notyp) {
OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(obj->typ->strobj);
}
OPM_WriteString((CHAR*)"(*)", 4);
OPC_AnsiParamList(obj->link, 0);
OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareParams(obj->link, 1);
OPM_Write(')'); OPM_Write(')');
} else { OPM_WriteLn();
OPC_Ident(obj->link);
OPM_WriteString((CHAR*)"__typ", 6);
} }
OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
if (obj->typ == OPT_notyp) {
OPM_WriteString((CHAR*)"void", 5);
} else {
OPC_Ident(obj->typ->strobj);
}
OPM_WriteString((CHAR*)"(*)", 4);
OPC_AnsiParamList(obj->link, 0);
OPM_WriteString((CHAR*)", ", 3);
OPC_DeclareParams(obj->link, 1);
OPM_Write(')');
OPM_WriteLn();
} }
OPC_DefineTProcMacros(obj->right, &*empty); OPC_DefineTProcMacros(obj->right, &*empty);
} }
@ -652,7 +654,7 @@ static void OPC_DefineType (OPT_Struct str)
{ {
OPT_Object obj = NIL, field = NIL, par = NIL; OPT_Object obj = NIL, field = NIL, par = NIL;
BOOLEAN empty; BOOLEAN empty;
if (OPM_currFile == 1 || str->ref < 255) { if ((OPM_currFile == 1 || str->ref < 255) || (((OPM_currFile == 0 && str->strobj != NIL)) && str->strobj->vis == 1)) {
obj = str->strobj; obj = str->strobj;
if (obj == NIL || OPC_Undefined(obj)) { if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) { if (obj != NIL) {
@ -681,6 +683,10 @@ static void OPC_DefineType (OPT_Struct str)
OPC_DefineType(str->BaseTyp); OPC_DefineType(str->BaseTyp);
} }
} else if (__IN(str->comp, 0x0c, 32)) { } else if (__IN(str->comp, 0x0c, 32)) {
if ((str->BaseTyp->strobj != NIL && str->BaseTyp->strobj->linkadr == 1)) {
OPM_Mark(244, str->txtpos);
str->BaseTyp->strobj->linkadr = 2;
}
OPC_DefineType(str->BaseTyp); OPC_DefineType(str->BaseTyp);
} else if (str->form == 12) { } else if (str->form == 12) {
if (str->BaseTyp != OPT_notyp) { if (str->BaseTyp != OPT_notyp) {
@ -715,6 +721,13 @@ static void OPC_DefineType (OPT_Struct str)
if (!empty) { if (!empty) {
OPM_WriteLn(); OPM_WriteLn();
} }
} else if ((obj->typ->form == 11 && obj->typ->BaseTyp->comp == 4)) {
empty = 1;
OPC_DeclareTProcs(obj->typ->BaseTyp->link, &empty);
OPC_DefineTProcMacros(obj->typ->BaseTyp->link, &empty);
if (!empty) {
OPM_WriteLn();
}
} }
} }
} }
@ -1138,7 +1151,7 @@ static void OPC_GenHeaderMsg (void)
OPM_WriteString((CHAR*)"/* ", 4); OPM_WriteString((CHAR*)"/* ", 4);
OPM_WriteString((CHAR*)"voc", 4); OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' '); OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, 75); OPM_WriteString(Configuration_versionLong, 76);
OPM_Write(' '); OPM_Write(' ');
i = 0; i = 0;
while (i <= 31) { while (i <= 31) {
@ -1739,7 +1752,7 @@ static void OPC_CharacterLiteral (INT64 c)
if ((c == 92 || c == 39) || c == 63) { if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\'); OPM_Write('\\');
} }
OPM_Write((CHAR)c); OPM_Write(__CHR(c));
OPM_Write('\''); OPM_Write('\'');
} }
} }
@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
c = (INT16)s[__X(i, s__len)]; c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) { if (c < 32 || c > 126) {
OPM_Write('\\'); OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6))); OPM_Write(__CHR(48 + __ASHR(c, 6)));
c = __MASK(c, -64); c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3))); OPM_Write(__CHR(48 + __ASHR(c, 3)));
c = __MASK(c, -8); c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c)); OPM_Write(__CHR(48 + c));
} else { } else {
if ((c == 92 || c == 34) || c == 63) { if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\'); OPM_Write('\\');
} }
OPM_Write((CHAR)c); OPM_Write(__CHR(c));
} }
i += 1; i += 1;
} }
@ -1830,6 +1843,12 @@ void OPC_IntLiteral (INT64 n, INT32 size)
void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
{ {
INT64 d;
d = dim;
while (d > 0) {
array = array->BaseTyp;
d -= 1;
}
if (array->comp == 3) { if (array->comp == 3) {
OPC_CompleteIdent(obj); OPC_CompleteIdent(obj);
OPM_WriteString((CHAR*)"__len", 6); OPM_WriteString((CHAR*)"__len", 6);
@ -1837,10 +1856,6 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
OPM_WriteInt(dim); OPM_WriteInt(dim);
} }
} else { } else {
while (dim > 0) {
array = array->BaseTyp;
dim -= 1;
}
OPM_WriteInt(array->n); OPM_WriteInt(array->n);
} }
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPC__h #ifndef OPC__h
#define OPC__h #define OPC__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -19,6 +19,8 @@ typedef
CHAR OPM_FileName[32]; CHAR OPM_FileName[32];
static CHAR OPM_currentComment[256];
static BOOLEAN OPM_hasComment;
static CHAR OPM_SourceFileName[256]; static CHAR OPM_SourceFileName[256];
static CHAR OPM_GlobalModel[10]; static CHAR OPM_GlobalModel[10];
export CHAR OPM_Model[10]; export CHAR OPM_Model[10];
@ -27,7 +29,7 @@ export INT16 OPM_AddressSize;
static INT16 OPM_GlobalAlignment; static INT16 OPM_GlobalAlignment;
export INT16 OPM_Alignment; export INT16 OPM_Alignment;
export UINT32 OPM_GlobalOptions, OPM_Options; export UINT32 OPM_GlobalOptions, OPM_Options;
export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
export INT64 OPM_MaxIndex; export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr; export BOOLEAN OPM_noerr;
@ -59,6 +61,7 @@ static void OPM_FindInstallDir (void);
static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos); static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len); static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch); export void OPM_Get (CHAR *ch);
export void OPM_GetComment (CHAR *text, ADDRESS text__len);
export void OPM_Init (BOOLEAN *done); export void OPM_Init (BOOLEAN *done);
export void OPM_InitOptions (void); export void OPM_InitOptions (void);
export INT16 OPM_Integer (INT64 n); export INT16 OPM_Integer (INT64 n);
@ -82,6 +85,7 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len);
static void OPM_ShowLine (INT64 pos); static void OPM_ShowLine (INT64 pos);
export INT64 OPM_SignedMaximum (INT32 bytecount); export INT64 OPM_SignedMaximum (INT32 bytecount);
export INT64 OPM_SignedMinimum (INT32 bytecount); export INT64 OPM_SignedMinimum (INT32 bytecount);
export void OPM_StoreComment (CHAR *text, ADDRESS text__len);
export void OPM_SymRCh (CHAR *ch); export void OPM_SymRCh (CHAR *ch);
export INT32 OPM_SymRInt (void); export INT32 OPM_SymRInt (void);
export INT64 OPM_SymRInt64 (void); export INT64 OPM_SymRInt64 (void);
@ -157,6 +161,36 @@ void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
__DEL(modname); __DEL(modname);
} }
void OPM_StoreComment (CHAR *text, ADDRESS text__len)
{
INT16 i;
__DUP(text, text__len, CHAR);
i = 0;
while ((i < 255 && text[__X(i, text__len)] != 0x00)) {
OPM_currentComment[__X(i, 256)] = text[__X(i, text__len)];
i += 1;
}
OPM_currentComment[__X(i, 256)] = 0x00;
OPM_hasComment = 1;
__DEL(text);
}
void OPM_GetComment (CHAR *text, ADDRESS text__len)
{
INT16 i;
if (OPM_hasComment) {
i = 0;
while ((((i < text__len && i < 256)) && OPM_currentComment[__X(i, 256)] != 0x00)) {
text[__X(i, text__len)] = OPM_currentComment[__X(i, 256)];
i += 1;
}
text[__X(i, text__len)] = 0x00;
OPM_hasComment = 0;
} else {
text[0] = 0x00;
}
}
INT64 OPM_SignedMaximum (INT32 bytecount) INT64 OPM_SignedMaximum (INT32 bytecount)
{ {
INT64 result; INT64 result;
@ -272,7 +306,7 @@ BOOLEAN OPM_OpenPar (void)
if (Modules_ArgCount == 1) { if (Modules_ArgCount == 1) {
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20); OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
OPM_LogWStr(Configuration_versionLong, 75); OPM_LogWStr(Configuration_versionLong, 76);
OPM_LogW('.'); OPM_LogW('.');
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52); OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52);
@ -338,7 +372,7 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT.", 95);
OPM_LogWLn(); OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn(); OPM_LogWLn();
@ -410,21 +444,25 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
case 'C': case 'C':
OPM_ShortintSize = 2; OPM_ShortintSize = 2;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 4;
break; break;
case 'V': case 'V':
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 4; OPM_IntegerSize = 4;
OPM_LongintSize = 8; OPM_LongintSize = 8;
OPM_SetSize = 8;
break; break;
default: default:
OPM_ShortintSize = 1; OPM_ShortintSize = 1;
OPM_IntegerSize = 2; OPM_IntegerSize = 2;
OPM_LongintSize = 4; OPM_LongintSize = 4;
OPM_SetSize = 4;
break; break;
} }
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024); __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
@ -606,7 +644,7 @@ static void OPM_ShowLine (INT64 pos)
if (pos >= (INT64)OPM_ErrorLineLimitPos) { if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1; pos = OPM_ErrorLineLimitPos - 1;
} }
i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos); i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768);
while (i > 0) { while (i > 0) {
OPM_LogW(' '); OPM_LogW(' ');
i -= 1; i -= 1;
@ -759,7 +797,7 @@ void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0); Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
if (tag != 0xf7 || ver != 0x83) { if (tag != 0xf7 || ver != 0x84) {
if (!__IN(4, OPM_Options, 32)) { if (!__IN(4, OPM_Options, 32)) {
OPM_err(-306); OPM_err(-306);
} }
@ -830,7 +868,7 @@ void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
if (OPM_newSFile != NIL) { if (OPM_newSFile != NIL) {
Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0); Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x83); Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
} else { } else {
OPM_err(153); OPM_err(153);
} }
@ -865,17 +903,17 @@ void OPM_WriteHex (INT64 i)
{ {
CHAR s[3]; CHAR s[3];
INT32 digit; INT32 digit;
digit = __ASHR((INT32)i, 4); digit = __ASHR(__SHORT(i, 2147483648LL), 4);
if (digit < 10) { if (digit < 10) {
s[0] = (CHAR)(48 + digit); s[0] = __CHR(48 + digit);
} else { } else {
s[0] = (CHAR)(87 + digit); s[0] = __CHR(87 + digit);
} }
digit = __MASK((INT32)i, -16); digit = __MASK(__SHORT(i, 2147483648LL), -16);
if (digit < 10) { if (digit < 10) {
s[1] = (CHAR)(48 + digit); s[1] = __CHR(48 + digit);
} else { } else {
s[1] = (CHAR)(87 + digit); s[1] = __CHR(87 + digit);
} }
s[2] = 0x00; s[2] = 0x00;
OPM_WriteString(s, 3); OPM_WriteString(s, 3);
@ -897,11 +935,11 @@ void OPM_WriteInt (INT64 i)
__MOVE("LL", s, 3); __MOVE("LL", s, 3);
k = 2; k = 2;
} }
s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10); i1 = __DIV(i1, 10);
k += 1; k += 1;
while (i1 > 0) { while (i1 > 0) {
s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10); i1 = __DIV(i1, 10);
k += 1; k += 1;
} }
@ -924,13 +962,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
CHAR s[32]; CHAR s[32];
CHAR ch; CHAR ch;
INT16 i; INT16 i;
if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) { if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == (__SHORT(__ENTIER(r), 2147483648LL)))) {
if (suffx == 'f') { if (suffx == 'f') {
OPM_WriteString((CHAR*)"(REAL)", 7); OPM_WriteString((CHAR*)"(REAL)", 7);
} else { } else {
OPM_WriteString((CHAR*)"(LONGREAL)", 11); OPM_WriteString((CHAR*)"(LONGREAL)", 11);
} }
OPM_WriteInt((INT32)__ENTIER(r)); OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL));
} else { } else {
Texts_OpenWriter(&W, Texts_Writer__typ); Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') { if (suffx == 'f') {
@ -1139,5 +1177,7 @@ export void *OPM__init(void)
OPM_MinReal = -OPM_MaxReal; OPM_MinReal = -OPM_MaxReal;
OPM_MinLReal = -OPM_MaxLReal; OPM_MinLReal = -OPM_MaxLReal;
OPM_FindInstallDir(); OPM_FindInstallDir();
OPM_hasComment = 0;
OPM_currentComment[0] = 0x00;
__ENDMOD; __ENDMOD;
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPM__h #ifndef OPM__h
#define OPM__h #define OPM__h
@ -9,7 +9,7 @@
import CHAR OPM_Model[10]; import CHAR OPM_Model[10];
import INT16 OPM_AddressSize, OPM_Alignment; import INT16 OPM_AddressSize, OPM_Alignment;
import UINT32 OPM_GlobalOptions, OPM_Options; import UINT32 OPM_GlobalOptions, OPM_Options;
import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize;
import INT64 OPM_MaxIndex; import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr; import BOOLEAN OPM_noerr;
@ -30,6 +30,7 @@ import void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
import void OPM_FPrintReal (INT32 *fp, REAL val); import void OPM_FPrintReal (INT32 *fp, REAL val);
import void OPM_FPrintSet (INT32 *fp, UINT64 val); import void OPM_FPrintSet (INT32 *fp, UINT64 val);
import void OPM_Get (CHAR *ch); import void OPM_Get (CHAR *ch);
import void OPM_GetComment (CHAR *text, ADDRESS text__len);
import void OPM_Init (BOOLEAN *done); import void OPM_Init (BOOLEAN *done);
import void OPM_InitOptions (void); import void OPM_InitOptions (void);
import INT16 OPM_Integer (INT64 n); import INT16 OPM_Integer (INT64 n);
@ -48,6 +49,7 @@ import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void); import void OPM_RegisterNewSym (void);
import INT64 OPM_SignedMaximum (INT32 bytecount); import INT64 OPM_SignedMaximum (INT32 bytecount);
import INT64 OPM_SignedMinimum (INT32 bytecount); import INT64 OPM_SignedMinimum (INT32 bytecount);
import void OPM_StoreComment (CHAR *text, ADDRESS text__len);
import void OPM_SymRCh (CHAR *ch); import void OPM_SymRCh (CHAR *ch);
import INT32 OPM_SymRInt (void); import INT32 OPM_SymRInt (void);
import INT64 OPM_SymRInt64 (void); import INT64 OPM_SymRInt64 (void);

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -634,7 +634,7 @@ static void OPP_StandProcCall (OPT_Node *x)
OPT_Node y = NIL; OPT_Node y = NIL;
INT8 m; INT8 m;
INT16 n; INT16 n;
m = (INT8)((INT16)(*x)->obj->adr); m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128);
n = 0; n = 0;
if (OPP_sym == 30) { if (OPP_sym == 30) {
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
@ -943,7 +943,7 @@ static void GetCode__19 (void)
(*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)]; (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
n += 1; n += 1;
} }
(*ext)[0] = (CHAR)n; (*ext)[0] = __CHR(n);
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
} else { } else {
for (;;) { for (;;) {
@ -956,14 +956,14 @@ static void GetCode__19 (void)
n = 1; n = 1;
} }
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
(*ext)[__X(n, 256)] = (CHAR)c; (*ext)[__X(n, 256)] = __CHR(c);
} }
if (OPP_sym == 19) { if (OPP_sym == 19) {
OPS_Get(&OPP_sym); OPS_Get(&OPP_sym);
} else if (OPP_sym == 35) { } else if (OPP_sym == 35) {
OPP_err(19); OPP_err(19);
} else { } else {
(*ext)[0] = (CHAR)n; (*ext)[0] = __CHR(n);
break; break;
} }
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPP__h #ifndef OPP__h
#define OPP__h #define OPP__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym)
OPS_err(241); OPS_err(241);
break; break;
} }
OPS_str[i] = OPS_ch; OPS_str[__X(i, 256)] = OPS_ch;
i += 1; i += 1;
} }
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
OPS_str[i] = 0x00; OPS_str[__X(i, 256)] = 0x00;
OPS_intval = i + 1; OPS_intval = i + 1;
if (OPS_intval == 2) { if (OPS_intval == 2) {
*sym = 35; *sym = 35;
@ -76,7 +76,7 @@ static void OPS_Identifier (INT8 *sym)
INT16 i; INT16 i;
i = 0; i = 0;
do { do {
OPS_name[i] = OPS_ch; OPS_name[__X(i, 256)] = OPS_ch;
i += 1; i += 1;
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
} while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256)); } while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256));
@ -84,7 +84,7 @@ static void OPS_Identifier (INT8 *sym)
OPS_err(240); OPS_err(240);
i -= 1; i -= 1;
} }
OPS_name[i] = 0x00; OPS_name[__X(i, 256)] = 0x00;
*sym = 38; *sym = 38;
} }
@ -143,7 +143,7 @@ static void OPS_Number (void)
if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) { if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) {
if (m > 0 || OPS_ch != '0') { if (m > 0 || OPS_ch != '0') {
if (n < 24) { if (n < 24) {
dig[n] = OPS_ch; dig[__X(n, 24)] = OPS_ch;
n += 1; n += 1;
} }
m += 1; m += 1;
@ -173,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1; OPS_numtyp = 1;
if (n <= 2) { if (n <= 2) {
while (i < n) { while (i < n) {
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1);
i += 1; i += 1;
} }
} else { } else {
@ -187,7 +187,7 @@ static void OPS_Number (void)
OPS_intval = -1; OPS_intval = -1;
} }
while (i < n) { while (i < n) {
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1);
i += 1; i += 1;
} }
} else { } else {
@ -196,7 +196,7 @@ static void OPS_Number (void)
} else { } else {
OPS_numtyp = 2; OPS_numtyp = 2;
while (i < n) { while (i < n) {
d = Ord__7(dig[i], 0); d = Ord__7(dig[__X(i, 24)], 0);
i += 1; i += 1;
if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) { if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
OPS_intval = OPS_intval * 10 + (INT64)d; OPS_intval = OPS_intval * 10 + (INT64)d;
@ -214,7 +214,7 @@ static void OPS_Number (void)
expCh = 'E'; expCh = 'E';
while (n > 0) { while (n > 0) {
n -= 1; n -= 1;
f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; f = (Ord__7(dig[__X(n, 24)], 0) + f) / (LONGREAL)(LONGREAL)10;
} }
if (OPS_ch == 'E' || OPS_ch == 'D') { if (OPS_ch == 'E' || OPS_ch == 'D') {
expCh = OPS_ch; expCh = OPS_ch;
@ -279,32 +279,74 @@ static void Comment__2 (void);
static void Comment__2 (void) static void Comment__2 (void)
{ {
BOOLEAN isExported;
CHAR commentText[256];
INT16 i, nestLevel;
CHAR prevCh, nextCh;
i = 0;
while (i <= 255) {
commentText[__X(i, 256)] = 0x00;
i += 1;
}
isExported = 0;
i = 0;
nestLevel = 1;
prevCh = 0x00;
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
for (;;) { if (OPS_ch == '*') {
for (;;) { isExported = 1;
while (OPS_ch == '(') { OPM_Get(&OPS_ch);
if (OPS_ch == ')') {
commentText[0] = 0x00;
OPM_StoreComment(commentText, 256);
OPM_Get(&OPS_ch);
return;
}
}
while ((nestLevel > 0 && OPS_ch != 0x00)) {
if ((prevCh == '(' && OPS_ch == '*')) {
nestLevel += 1;
prevCh = 0x00;
} else if ((prevCh == '*' && OPS_ch == ')')) {
nestLevel -= 1;
if (nestLevel == 0) {
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
if (OPS_ch == '*') { } else {
Comment__2(); prevCh = 0x00;
}
} else {
if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
} }
} }
if (OPS_ch == '*') { prevCh = OPS_ch;
OPM_Get(&OPS_ch); }
break; if (nestLevel > 0) {
}
if (OPS_ch == 0x00) {
break;
}
OPM_Get(&OPS_ch); OPM_Get(&OPS_ch);
} }
if (OPS_ch == ')') { }
OPM_Get(&OPS_ch); if (OPS_ch == 0x00) {
break; OPS_err(5);
}
if ((((((isExported && nestLevel == 0)) && prevCh != 0x00)) && prevCh != '*')) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
} else {
OPM_LogWStr((CHAR*)"Truncating final comment character", 35);
OPM_LogWLn();
} }
if (OPS_ch == 0x00) { }
OPS_err(5); if (isExported) {
break; if (i >= 256) {
OPM_LogWStr((CHAR*)"Warning: commentText overflow", 30);
OPM_LogWLn();
i = 255;
} }
commentText[__X(i, 256)] = 0x00;
OPM_StoreComment(commentText, 256);
} }
} }

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPS__h #ifndef OPS__h
#define OPS__h #define OPS__h

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#define SHORTINT INT8 #define SHORTINT INT8
#define INTEGER INT16 #define INTEGER INT16
@ -83,6 +83,7 @@ typedef
OPT_Const conval; OPT_Const conval;
INT32 adr, linkadr; INT32 adr, linkadr;
INT16 x; INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc; } OPT_ObjDesc;
typedef typedef
@ -173,6 +174,7 @@ static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par); static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ); static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj); static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len);
export OPT_Struct OPT_SetType (INT32 size); export OPT_Struct OPT_SetType (INT32 size);
export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir); export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir);
export INT32 OPT_SizeAlignment (INT32 size); export INT32 OPT_SizeAlignment (INT32 size);
@ -352,7 +354,7 @@ void OPT_TypSize (OPT_Struct typ)
} }
typ->size = offset; typ->size = offset;
typ->align = base; typ->align = base;
typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8); typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768);
} else if (c == 2) { } else if (c == 2) {
OPT_TypSize(typ->BaseTyp); OPT_TypSize(typ->BaseTyp);
typ->size = typ->n * typ->BaseTyp->size; typ->size = typ->n * typ->BaseTyp->size;
@ -388,6 +390,10 @@ OPT_Object OPT_NewObj (void)
{ {
OPT_Object obj = NIL; OPT_Object obj = NIL;
__NEW(obj, OPT_ObjDesc); __NEW(obj, OPT_ObjDesc);
obj->typ = NIL;
obj->conval = NIL;
obj->comment = NIL;
obj->name[0] = 0x00;
return obj; return obj;
} }
@ -554,6 +560,8 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
OPT_Object ob0 = NIL, ob1 = NIL; OPT_Object ob0 = NIL, ob1 = NIL;
BOOLEAN left; BOOLEAN left;
INT8 mnolev; INT8 mnolev;
CHAR commentText[256];
INT16 j;
ob0 = OPT_topScope; ob0 = OPT_topScope;
ob1 = ob0->right; ob1 = ob0->right;
left = 0; left = 0;
@ -585,6 +593,16 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
__COPY(name, ob1->name, 256); __COPY(name, ob1->name, 256);
mnolev = OPT_topScope->mnolev; mnolev = OPT_topScope->mnolev;
ob1->mnolev = mnolev; ob1->mnolev = mnolev;
OPM_GetComment((void*)commentText, 256);
if (commentText[0] != 0x00) {
ob1->comment = __NEWARR(NIL, 1, 1, 1, 0, ((INT64)(256)));
j = 0;
while ((j < 255 && commentText[__X(j, 256)] != 0x00)) {
(*ob1->comment)[__X(j, 256)] = commentText[__X(j, 256)];
j += 1;
}
(*ob1->comment)[__X(j, 256)] = 0x00;
}
break; break;
} }
} }
@ -1103,6 +1121,13 @@ static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
tag = OPM_SymRInt(); tag = OPM_SymRInt();
last = NIL; last = NIL;
while (tag != 18) { while (tag != 18) {
if (tag < 0 || tag > 100) {
OPM_LogWStr((CHAR*)"ERROR: Invalid tag value in InSign: ", 37);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return;
}
new = OPT_NewObj(); new = OPT_NewObj();
new->mnolev = -mno; new->mnolev = -mno;
if (last == NIL) { if (last == NIL) {
@ -1251,7 +1276,7 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0; obj->vis = 0;
tag = OPM_SymRInt(); tag = OPM_SymRInt();
if (tag == 35) { if (tag == 35) {
(*typ)->sysflag = (INT16)OPM_SymRInt(); (*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768);
tag = OPM_SymRInt(); tag = OPM_SymRInt();
} }
switch (tag) { switch (tag) {
@ -1381,7 +1406,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPT_Struct typ = NIL; OPT_Struct typ = NIL;
INT32 tag; INT32 tag;
OPT_ConstExt ext = NIL; OPT_ConstExt ext = NIL;
OPS_Name commentText;
BOOLEAN hasComment;
INT16 j;
INT32 len;
tag = OPT_impCtxt.nextTag; tag = OPT_impCtxt.nextTag;
hasComment = 0;
while (tag == 41) {
len = OPM_SymRInt();
if (len < 0) {
len = 0;
}
if (len > 255) {
len = 255;
}
i = 0;
while (i < len) {
OPM_SymRCh(&commentText[__X(i, 256)]);
i += 1;
}
commentText[__X(i, 256)] = 0x00;
hasComment = 1;
tag = OPM_SymRInt();
}
OPT_impCtxt.nextTag = tag;
if (tag < 0 || tag > 50) {
OPM_LogWStr((CHAR*)"ERROR: Invalid tag in InObj: ", 30);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return NIL;
}
if (tag == 19) { if (tag == 19) {
OPT_InStruct(&typ); OPT_InStruct(&typ);
obj = typ->strobj; obj = typ->strobj;
@ -1397,7 +1452,7 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->conval = OPT_NewConst(); obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval); OPT_InConstant(tag, obj->conval);
obj->typ = OPT_InTyp(tag); obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) { } else if ((tag >= 31 && tag <= 33)) {
obj->conval = OPT_NewConst(); obj->conval = OPT_NewConst();
obj->conval->intval = -1; obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link); OPT_InSign(mno, &obj->typ, &obj->link);
@ -1412,8 +1467,8 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->mode = 9; obj->mode = 9;
ext = OPT_NewExt(); ext = OPT_NewExt();
obj->conval->ext = ext; obj->conval->ext = ext;
s = (INT16)OPM_SymRInt(); s = __SHORTF(OPM_SymRInt(), 32768);
(*ext)[0] = (CHAR)s; (*ext)[0] = __CHR(s);
i = 1; i = 1;
while (i <= s) { while (i <= s) {
OPM_SymRCh(&(*ext)[__X(i, 256)]); OPM_SymRCh(&(*ext)[__X(i, 256)]);
@ -1424,20 +1479,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32); OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
OPM_LogWNum(tag, 0); OPM_LogWNum(tag, 0);
OPM_LogWLn(); OPM_LogWLn();
OPM_err(155);
return NIL;
break; break;
} }
} else if (tag == 20) { } else if (tag == 20) {
obj->mode = 5; obj->mode = 5;
OPT_InStruct(&obj->typ); OPT_InStruct(&obj->typ);
} else { } else if (tag == 21 || tag == 22) {
obj->mode = 1; obj->mode = 1;
if (tag == 22) { if (tag == 22) {
obj->vis = 2; obj->vis = 2;
} }
OPT_InStruct(&obj->typ); OPT_InStruct(&obj->typ);
} else {
OPM_LogWStr((CHAR*)"ERROR: Unexpected tag in InObj: ", 33);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return NIL;
} }
OPT_InName((void*)obj->name, 256); OPT_InName((void*)obj->name, 256);
} }
if ((hasComment && obj != NIL)) {
obj->comment = __NEWARR(NIL, 1, 1, 1, 0, ((INT64)(256)));
j = 0;
while ((((j < 255 && j < len)) && commentText[__X(j, 256)] != 0x00)) {
(*obj->comment)[__X(j, 256)] = commentText[__X(j, 256)];
j += 1;
}
(*obj->comment)[__X(j, 256)] = 0x00;
}
OPT_FPrintObj(obj); OPT_FPrintObj(obj);
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) { if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255); OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
@ -1752,7 +1824,7 @@ static void OPT_OutConstant (OPT_Object obj)
OPM_SymWInt(f); OPM_SymWInt(f);
switch (f) { switch (f) {
case 2: case 3: case 2: case 3:
OPM_SymWCh((CHAR)obj->conval->intval); OPM_SymWCh(__CHR(obj->conval->intval));
break; break;
case 4: case 4:
OPM_SymWInt(obj->conval->intval); OPM_SymWInt(obj->conval->intval);
@ -1780,13 +1852,40 @@ static void OPT_OutConstant (OPT_Object obj)
} }
} }
static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len)
{
INT16 i;
__DUP(text, text__len, CHAR);
i = 0;
while ((i < 255 && text[__X(i, text__len)] != 0x00)) {
OPM_SymWCh(text[__X(i, text__len)]);
i += 1;
}
OPM_SymWCh(0x00);
__DEL(text);
}
static void OPT_OutObj (OPT_Object obj) static void OPT_OutObj (OPT_Object obj)
{ {
INT16 i, j; INT16 i, j;
OPT_ConstExt ext = NIL; OPT_ConstExt ext = NIL;
INT16 k, l;
if (obj != NIL) { if (obj != NIL) {
OPT_OutObj(obj->left); OPT_OutObj(obj->left);
if (__IN(obj->mode, 0x06ea, 32)) { if (__IN(obj->mode, 0x06ea, 32)) {
if (obj->comment != NIL) {
OPM_SymWInt(41);
k = 0;
while ((k < 255 && (*obj->comment)[__X(k, 256)] != 0x00)) {
k += 1;
}
OPM_SymWInt(k);
l = 0;
while (l < k) {
OPM_SymWCh((*obj->comment)[__X(l, 256)]);
l += 1;
}
}
if (obj->history == 4) { if (obj->history == 4) {
OPT_FPrintErr(obj, 250); OPT_FPrintErr(obj, 250);
} else if (obj->vis != 0) { } else if (obj->vis != 0) {
@ -2026,7 +2125,7 @@ static void EnumPtrs(void (*P)(void*))
} }
__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -16}}; __TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -16}};
__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 336), {0, 8, 16, 24, 304, 312, -56}}; __TDESC(OPT_ObjDesc, 1, 7) = {__TDFLDS("ObjDesc", 344), {0, 8, 16, 24, 304, 312, 336, -64}};
__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 72), {48, 56, 64, -32}}; __TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 72), {48, 56, 64, -32}};
__TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 56), {0, 8, 16, 32, 40, 48, -56}}; __TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 56), {0, 8, 16, 32, 40, 48, -56}};
__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 5184), {16, 24, 32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120, 128, 136, __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 5184), {16, 24, 32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120, 128, 136,

View file

@ -1,4 +1,4 @@
/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ /* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
#ifndef OPT__h #ifndef OPT__h
#define OPT__h #define OPT__h
@ -61,6 +61,7 @@ typedef
OPT_Const conval; OPT_Const conval;
INT32 adr, linkadr; INT32 adr, linkadr;
INT16 x; INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc; } OPT_ObjDesc;
typedef typedef

Some files were not shown because too many files have changed in this diff Show more