Compare commits

...

260 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
David Brown
305781e000 Version 2.1.0 - update version and add history. 2016-12-20 17:27:47 +00:00
David Brown
3cb60cc59f Update C bootstrap source. 2016-12-20 15:17:12 +00:00
David Brown
412a8c3337 Document compilation; remove OpenBSD debugging. 2016-12-20 15:16:18 +00:00
David Brown
c6388006b9 Update bootstrap C source. 2016-12-19 16:12:09 +00:00
David Brown
8220c4e807 Fix heap for -OC build on 32 bit systems. 2016-12-19 16:11:32 +00:00
David Brown
43117e79f7 Integrate JTempl's new OFront heap implementation using unsigned address arithmetic. 2016-12-19 16:00:57 +00:00
David Brown
6f43c272c9 Update bootstrap C sources. 2016-12-18 17:13:46 +00:00
David Brown
7386767d84 Fix binary dir determination for mingw/msc. 2016-12-18 17:12:00 +00:00
David Brown
fc385eca3c Update bootstrap C sources. 2016-12-18 16:34:33 +00:00
David Brown
5c5ca01dbc Fix overenthusiastic deletion of .sym files for -F forcenewym. Whoops. 2016-12-18 16:33:41 +00:00
David Brown
28d4bc8219 -F doesn'teven try opening existing sym file. -s silently replaces old version sym file. 2016-12-18 14:51:27 +00:00
David Brown
4c7aa1720a Update bootstrap C sources. 2016-12-18 13:05:05 +00:00
David Brown
460b879829 Build link list based on imports, not on modules compiled by compiler instance. 2016-12-18 13:03:59 +00:00
David Brown
4a71f43e72 Update bootstrap C source files. 2016-12-14 16:56:57 +00:00
David Brown
e85091289e Fix array assignment size validation to accept equal sizes. 2016-12-14 16:55:16 +00:00
David Brown
1e9c1af8ef Update bootstrap C sources. 2016-12-13 20:16:38 +00:00
David Brown
41a239c5aa Fix heap address comparisons for sign crossing. 2016-12-13 20:15:29 +00:00
David Brown
6507b4ede3 Update bootstrap C sources. 2016-12-13 18:53:34 +00:00
David Brown
85eeef6ae4 Supportix dump of block with uncleared GC flag in bit 0 of tag. 2016-12-13 18:52:42 +00:00
David Brown
d4c5d63978 Update bootstrap C sources. 2016-12-13 18:43:20 +00:00
David Brown
30bae1a622 Fix dump of chunk that crosses +ve to -ve address. Could this be the underlying issue in Heap? 2016-12-13 18:42:16 +00:00
David Brown
d7de570177 Update bootstrap C sources. 2016-12-13 18:27:35 +00:00
David Brown
a377c7c3bf Still chasing OpenBSD issue. Add heap dump. Looks like a GC fault. 2016-12-13 18:25:50 +00:00
David Brown
13241fabba Update bootstrap C sources. 2016-12-12 20:06:40 +00:00
David Brown
c5561dd0e0 Make type descriptor dump resilient to increments (mid-GC) tags. 2016-12-12 20:06:00 +00:00
David Brown
d9fb831fcf Update bootstrap C sources. 2016-12-12 18:43:32 +00:00
David Brown
4444d06e4e Remove duplocate ModuleDesc in Modules. Add type descriptor dumping. 2016-12-12 18:42:36 +00:00
David Brown
80512b6ecc Update bootstrap sources. 2016-12-11 20:19:08 +00:00
David Brown
f75a98d3dc Display text run dump according to its dynamic type. 2016-12-11 20:18:34 +00:00
David Brown
27e3b57616 Update bootstrap sources. 2016-12-11 17:43:47 +00:00
David Brown
6e28d3f2fd Ha! Now fix hexdump for -OC build. 2016-12-11 17:43:05 +00:00
David Brown
c409b84e68 Update bootstrap sources. 2016-12-11 17:32:23 +00:00
David Brown
3c1e64375e Fix hexdump on 32 bit builds. 2016-12-11 17:31:25 +00:00
David Brown
fb3017e3e2 Update bootstrap C source. 2016-12-11 17:19:18 +00:00
David Brown
a2d98748b6 Add hex and hexdump to Out.Mod, more debugging for OpenBSD. 2016-12-11 17:18:24 +00:00
David Brown
7d0cc741ae Update bootstrap C source 2016-12-11 14:11:33 +00:00
David Brown
a1ac23a09f More debug to catch OpenBSD intermittent text read failure. 2016-12-11 14:10:46 +00:00
David Brown
7aad84604b Update bootstrap C source. 2016-12-10 18:45:47 +00:00
David Brown
18a365429b Add dubug dump to Texts.Mod to help catch OpenBSD specific read failure. 2016-12-10 18:44:59 +00:00
David Brown
c3fc777f6f Update bootsrap C sources. 2016-12-09 17:50:59 +00:00
David Brown
d12393cc8c Build to local directory and install as separate optional step. 2016-12-09 17:47:48 +00:00
David Brown
c41cb011b6 Working on autobuild. 2016-12-07 17:39:17 +00:00
David Brown
dab579bdd5 Working on autobuild. 2016-12-07 17:29:18 +00:00
David Brown
f3ff731794 Working on autobuild. 2016-12-07 17:18:00 +00:00
David Brown
06be24f32f Working on build system 2016-12-07 17:06:52 +00:00
David Brown
2ec543867b Working on build system 2016-12-07 17:03:36 +00:00
David Brown
0313c30307 Working on build system 2016-12-07 16:42:59 +00:00
David Brown
86fddce532 Merge branch 'master' of https://github.com/vishaps/voc 2016-12-07 16:32:21 +00:00
David Brown
442f377b7e New autobuild process 2016-12-07 16:29:01 +00:00
norayr
fd27239b2d changed help to conform to the binary name. -- noch 2016-12-07 19:47:51 +04:00
norayr
04760174fb Merge branch 'master' of https://github.com/vishaps/voc 2016-12-07 19:44:58 +04:00
norayr
1e15d47936 renamed to vbeautify, added makefile. -- noch 2016-12-07 19:43:45 +04:00
norayr
e6532bfe23 reverted back Texts module changes. 2016-12-07 19:40:08 +04:00
norayr
886c18303e added dump text functions to beautifier. 2016-12-07 19:38:07 +04:00
norayr
9f6c788219 texts module can save plain ascii files with CloseAscii function. 2016-12-07 19:31:48 +04:00
norayr
d18008eafa Beautifier compiled 2016-12-07 18:57:55 +04:00
David Brown
2e436a2d9e More fiddling with auto build scripts. 2016-12-07 14:06:39 +00:00
David Brown
da1ad6e871 I'm still making a mess of the auto build scripts. 2016-12-07 14:05:04 +00:00
David Brown
bde475c384 Silly me, it's a .sh, not a .pl., temporarily have buildall pick up the new .sh. 2016-12-07 14:03:07 +00:00
norayr
ada56e2770 Beautifier converted to plain ascii file. 2016-12-07 17:44:45 +04:00
norayr
9d7f23c918 ocat fixed 2016-12-07 17:44:01 +04:00
norayr
c5f0e1e345 added original Beautifier module. 2016-12-07 17:43:09 +04:00
David Brown
72ba766a2d Slightly simplify auto build repository sync. 2016-12-07 13:11:30 +00:00
David Brown
16c3f32484 Merge branch 'master' of https://github.com/vishaps/voc 2016-12-07 13:09:06 +00:00
David Brown
4b0fb0d1fb Slightly simplify auto build repository sync. 2016-12-07 13:07:21 +00:00
David Brown
83d943297f Use single quote string dilimieters for printf in oberon.mk. 2016-12-06 18:46:37 +00:00
norayr
576c57b39b update of bootstrap sources. 2016-12-06 20:38:09 +04:00
norayr
d210376421 reverted back to using string literals. -- noch 2016-12-06 20:35:58 +04:00
norayr
58ea173d94 added "showdef" related information to the readme. -- noch 2016-12-06 18:28:33 +04:00
norayr
8d28c1b1bb updated bootstrap sources. -- noch 2016-12-06 17:52:15 +04:00
norayr
4fda478a28 replaced most of string constants by OPT.sometyp.strobj.name. -- noch 2016-12-06 17:47:48 +04:00
norayr
d009eb2e34 updated bootstrap c sources. -- noch 2016-12-06 13:13:02 +04:00
norayr
6cd7727802 removed tests. -- noch 2016-12-06 13:11:44 +04:00
norayr
93eea47e54 improved warning message. -- noch 2016-12-06 11:32:21 +04:00
norayr
22c5977fe3 updated bootstrap sources. -- noch 2016-12-05 22:13:29 +04:00
norayr
836e26dd47 added TRUE, FALSE, SET to the check. -- noch 2016-12-05 22:12:10 +04:00
norayr
711283cba5 added type aliasing check and warning. -- noch 2016-12-05 22:06:10 +04:00
David Brown
de049dc80c Add OPM_InstallDir to ignored differences between bootstrap and installable builds. 2016-12-05 17:23:34 +00:00
David Brown
cf2da3000f Record curpos on every inR.Read. Add more debug to catch OpenBSD read failure. 2016-12-05 17:00:55 +00:00
David Brown
c7e88f4634 Update bootstrap C source. 2016-12-05 12:07:40 +00:00
David Brown
e6c858e6e7 Prototype for finding installation based on binary name. 2016-12-04 17:56:06 +00:00
David Brown
a6049e7b82 Update bootstrap C sources. 2016-12-03 18:44:22 +00:00
David Brown
1ae3a2ff32 Simplify ARGV setup. Add trial binary directory discovery code. 2016-12-03 18:43:13 +00:00
David Brown
8c9d029df3 Fix error message display during library build. 2016-12-03 12:07:16 +00:00
Norayr Chilingarian
61828e6a47 Merge branch 'ulm_tidy' 2016-12-02 19:12:16 +04:00
David Brown
6beeaa5626 Update bootstrap C sources. 2016-12-02 13:03:18 +00:00
David Brown
5c3b42be09 Fix incorrect dynarray length type merge with subsequent longint in IdentList. 2016-12-02 13:02:35 +00:00
David Brown
6c0c666f91 Update bootstrap C sources. 2016-12-02 12:27:03 +00:00
David Brown
c57a91210b Append 'LL' to large integer constants to avoid OpenBSD gcc warnings. 2016-12-02 12:26:21 +00:00
David Brown
62c6d5c2a4 Update C bootstrap source. 2016-12-01 18:40:01 +00:00
David Brown
c65b89daf3 Update confidence tests for arg handling move. Remove unused vars in Platform. 2016-12-01 18:39:02 +00:00
David Brown
299b0636ad Fix Platform initialisation, move common Arg handling code from Platfrom to Modules. 2016-12-01 18:08:08 +00:00
David Brown
aed9134e99 Allow Revised Oberon array assignment (source may be shorter than target). 2016-12-01 17:57:27 +00:00
David Brown
b16e82f866 Update open FileDescs at deregistration resulting from delete, rename or register. 2016-11-30 18:13:32 +00:00
David Brown
67e4848eb7 PlatformWindows file sharing mode parity with PlatfromUnix. Allow GC to collect unused files. 2016-11-30 15:49:27 +00:00
norayr
0e1c5fe498 ulm library compiled by fixing integer, longint, shortint and set sizes. -- noch 2016-11-30 19:39:26 +04:00
David Brown
f72b4280b7 Merge branch 'master' of https://github.com/vishaps/voc 2016-11-29 15:44:23 +00:00
David Brown
19af6d76d3 Update bootstrap C source. 2016-11-29 15:43:11 +00:00
David Brown
9f0cbccf55 Various fixes to OS vs Oberon file lifetime management in Files.Mod. 2016-11-29 15:27:30 +00:00
norayr
c549f5847b fixed Longint to Byte Arr function; -- noch 2016-11-29 16:45:18 +04:00
norayr
247852e0b7 fixed overflow in LRealToByteArr; -- noch 2016-11-29 16:14:15 +04:00
norayr
047d8b94e7 plongrealarray had to be pointer to longrealarray. -- noch 2016-11-29 15:00:18 +04:00
norayr
a22c894fd4 removed ORP PO13 compiler version from the voc source tree. -- noch 2016-11-29 13:13:48 +04:00
David Brown
51ae4c3241 Update C bootstrap. 2016-11-28 15:57:49 +00:00
David Brown
d5c3d2aae5 Merge __GUARDEQP changes from OFront. 2016-11-28 15:57:04 +00:00
David Brown
b9339c9516 Merge heap fix for negative addresses from OFront. Fix ulmSets CharSet size. 2016-11-28 14:56:10 +00:00
David Brown
c630f86399 Update C bootstrap sources 2016-11-27 16:49:12 +00:00
David Brown
6a7cba23a7 Force output flush and nonzero return code on assertion failure in Files.Mod 2016-11-27 16:48:03 +00:00
David Brown
7279aa91be Update bootstrap C source. 2016-11-25 13:03:26 +00:00
David Brown
cbf78cb6f1 Fix allocation size for dynarry dope vector - ADDRESS rather than LONGINT. 2016-11-25 12:45:33 +00:00
David Brown
5ae282dc9f Trigger build (after dragging each build machine past the v2.00 tag.) 2016-11-24 19:00:46 +00:00
David Brown
056a317e54 Remove SetHalt documentation - code was already disabled. 2016-11-24 18:10:51 +00:00
330 changed files with 15040 additions and 14081 deletions

4
.gitattributes vendored
View file

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

10
.gitignore vendored
View file

@ -2,6 +2,7 @@
/Configuration.Mod
/Configuration.Make
/build/*
/install/*
/*.exe
/*.obj
/*.[cho]
@ -10,6 +11,7 @@
/*.sym
/*.asm
/*.mod
/Errors.Txt
/Errors.txt
/olang
/src/test/**/*.exe
@ -19,9 +21,11 @@
/src/test/**/*.obj
/src/test/**/*.sym
**/*.stackdump
!/src/test/confidence/**/expected
/src/test/confidence/**/input
/src/test/confidence/**/result
/src/test/confidence/**/result-*
/src/test/confidence/**/*[^.]*
/src/test/confidence/**/*.asm
/src/test/confidence/**/*.s
/src/test/confidence/**/*.map
@ -34,3 +38,9 @@
**/.tmp.*
/*.pdb
/*.ilk
/t/*
/triage/BasicTypeSize.md
/triage/Roadmap.md
triage/system/*
tags
voc

137
ReadMe.md
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](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
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
libraries from the Ulm, oo2c and Ofront Oberon compilers, as well as
default libraries complying with the Oakwood Guidelines for Oberon-2 compilers.
@ -14,8 +14,8 @@ default libraries complying with the Oakwood Guidelines for Oberon-2 compilers.
### Contents
&nbsp;&nbsp;&nbsp;&nbsp;[**Installation**](#installation)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**A 'Hello' application**](#a-hello-application)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Licensing**](#licensing)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Compiling a 'Hello' application**](#a-hello-application)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**License**](#license)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Platform support and porting**](#platform-support-and-porting)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Language support and libraries**](#language-support-and-libraries)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**History**](#history)<br>
@ -27,8 +27,18 @@ default libraries complying with the Oakwood Guidelines for Oberon-2 compilers.
## Installation
While pre-built packages are not provided, it is easy to install the Oberon compiler and libraries
with the following simple steps.
It is easy to install the Oberon compiler and libraries
with the following simple steps:
1. Install pre-requisites such as git, gcc, static C libraries, diff utils.
2. Clone the repository: `git clone https://github.com/vishaps/voc`.
3. Optionally `export CC=clang` or `export CC=tcc`.
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:
#### 1. Install prerequisites
@ -43,28 +53,57 @@ with the following simple steps.
More details, including for MingW and MS C, in [**Installation**](/doc/Installation.md).
#### 2. Build and install the compiler and libraries
#### 2. Clone and build the compiler and libraries
1. `git clone https://github.com/vishaps/voc`
2. `cd voc`
3. `[sudo] make full`
3. `make full`
Since 'make full' will install the compiler and libraries, it needs root (unix) or administrator (windows) privileges.
`make full` will create an installation directory under your local repository at voc/install.
#### 3. Set your PATH environment variable
`mmake full` runs `ldconfig` to configure the linker to find libraries in voc/install, but you
need to update your program search PATH yourself (see step 4 below).
Set your path to the installed compiler binary location as reported
by make full, e.g.
| System | Set path |
#### 3. Optionally install to a system directory
Run `make install` as root to copy the voc/install directory to the appropriate directory
for your OS as follows:
| System | Where `make install` puts the installation |
| ------- | -------------------------------------- |
| Linux | `/opt/voc` |
| BSD | `/usr/local/share/voc` |
| Windows | See [**Windows installation**](/doc/Winstallation.md) |
| Termux | `/data/data/com.termux/files/opt/voc` |
`make install` updates `ldconfg` with the new library locations.
#### 4. Set your PATH environment variable
Since there are so many ways that different systems and users manage their PATHs, we leave
it to you to update your path to include the compiler binary.
Both `make full` and `make install` display instructions on setting the path specific to your
system.
For reference this will be:
| Installation choice | Set path |
| --------- | -------------------------------------- |
| Linux | `export PATH="/opt/voc/bin:$PATH"` |
| BSD | `export PATH="/usr/local/share/voc/bin:$PATH"` |
| Windows | See [Installation](/doc/Installation.md) |
| Termux | `export PATH="/data/data/com.termux/files/opt/voc/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 BSD | `export PATH="/usr/local/share/voc/bin:$PATH"` |
| `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"` |
Also see [**Installation**](/doc/Installation.md).
The compiler finds the rest of the installation based on the location from which it is loaded.
## A 'Hello' application
@ -88,7 +127,7 @@ Alternatively the Oakwood module Out can be used to write directly to stdout:
MODULE hello;
IMPORT Out;
BEGIN
Out.String("Hello."); Out.Ln;
Out.String("Hello."); Out.Ln
END hello.
```
@ -99,12 +138,35 @@ Compile as follows:
The -m parameter tells voc that this is a main module, and to generate an
executable binary.
Execute as usual on Linux ('./hello') or Windows ('hello').
Execute as usual on Linux (`./hello`) or Windows (`hello`).
For more details on compilation, see [**Compiling**](/doc/Compiling.md).
### Viewing the interfaces of included modules.
In order to see the definition of a module's interface, use the "showdef" program.
```
$ showdef Out
DEFINITION Out;
VAR
IsConsole-: BOOLEAN;
PROCEDURE Char(ch: CHAR);
PROCEDURE Flush;
PROCEDURE Int(x: INT64; n: INT64);
PROCEDURE Ln;
PROCEDURE LongReal(x: LONGREAL; n: INT16);
PROCEDURE Open;
PROCEDURE Real(x: REAL; n: INT16);
PROCEDURE String(str: ARRAY OF CHAR);
END Out.
```
Also see [**Compiling**](/doc/Compiling.md).
## Licensing
## License
Vishap Oberon's frontend and C backend engine is a fork of Josef Templs Ofront, which has been released
under the FreeBSD License. Unlike Ofront, Vishap Oberon does not include the Oberon v4 GUI environment.
@ -119,9 +181,9 @@ Most of the runtime in libVishapOberon is distributed under GPLv3 with runtime e
## 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).
@ -185,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.
## Origin of the name "Ѵishap Oberon"
#### Oberon
## Oberon
Oberon is a programming language, an operating system and a graphical
user interface. Originally designed and implemented by by Niklaus Wirth and
@ -206,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,
> translated by Lewis Galantière.)
#### Ѵishap
## Origin of the name "Ѵishap Oberon"
Vishaps are dragons inhabiting the Armenian Highlands.
We decided to name the project “Vishap” because ties between compilers and dragons have ancient traditions.
@ -218,13 +278,13 @@ Also, Vishaps are known in tales, fiction. [This page](http://blog.fogus.me/2015
###### Oberon
- [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)
- [Project Oberon: The Design of an Operating System and Compiler ](http://www.ethoberon.ethz.ch/WirthPubl/ProjectOberon.pdf)
- [Oberon - the Overlooked Jewel](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.90.7173&rep=rep1&type=pdf)
- [Project Oberon: The Design of an Operating System and Compiler ](https://people.inf.ethz.ch/wirth/ProjectOberon1992.pdf)
- [Oberon - the Overlooked Jewel](http://pascal.hansotten.com/uploads/oberonpi/Oberon%20article.pdf)
###### 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)
- [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)
###### Oberon 07
@ -234,7 +294,12 @@ Also, Vishaps are known in tales, fiction. [This page](http://blog.fogus.me/2015
###### Links
- [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/)
- [Joseph Templ's ofront on github](https://hithub.com/jtempl/ofront)
- [Selected articles by Niklaus Wirth](https://people.inf.ethz.ch/wirth/SelectedArticles.pdf)
- [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)
- [Oberon: Steps beyond Pascal and Modula](http://fruttenboel.verhoeven272.nl/Oberon/)
## History
See [**History**](/doc/History.md).

View file

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

View file

@ -18,9 +18,13 @@
#else
typedef unsigned long size_t;
#endif
#else
#if defined(__OpenBSD__)
typedef unsigned long size_t;
#else
typedef unsigned int size_t;
#endif
#endif
#define _SIZE_T_DECLARED // For FreeBSD
#define _SIZE_T_DEFINED_ // For OpenBSD
@ -112,9 +116,11 @@ extern void Modules_AssertFail(INT32 x);
// Index checking
static inline INT64 __XF(UINT64 i, UINT64 ub) {if (i >= ub) {__HALT(-2);} return i;}
#define __X(i, ub) (((i)<(ub))?i:(__HALT(-2),0))
static inline INT64 __XF(INT64 i, UINT64 ub) {
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
@ -237,7 +243,7 @@ static inline double SYSTEM_ABSD(double i) {return i >= 0.0 ? i : -i;}
#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*((typ*)p)
@ -258,10 +264,15 @@ extern void Heap_INCREF();
// Main module initialisation, registration and finalisation
extern void Platform_Init(INT32 argc, ADDRESS argv);
extern void Modules_Init(INT32 argc, ADDRESS argv);
extern void Heap_FINALL();
#define __INIT(argc, argv) static void *m; Platform_Init(argc, (ADDRESS)&argv);
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);
#endif
#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum)
#define __FINI Heap_FINALL(); return 0

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -20,9 +20,9 @@
#include "extTools.h"
static CHAR Compiler_mname[256];
static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len);
export void Compiler_Module (BOOLEAN *done);
static void Compiler_PropagateElementaryTypeSizes (void);
export void Compiler_Translate (void);
@ -41,11 +41,12 @@ void Compiler_Module (BOOLEAN *done)
OPT_Export(&ext, &new);
if (OPM_noerr) {
OPM_OpenFiles((void*)OPT_SelfName, 256);
OPM_DeleteObj((void*)OPT_SelfName, 256);
OPC_Init();
OPV_Module(p);
if (OPM_noerr) {
if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
OPM_DeleteNewSym();
OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogWStr((CHAR*)" Main program.", 16);
OPM_LogVT100((CHAR*)"0m", 3);
@ -61,7 +62,7 @@ void Compiler_Module (BOOLEAN *done)
}
}
} else {
OPM_DeleteNewSym();
OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@ -88,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp;
switch (OPM_LongintSize) {
switch (OPM_SetSize) {
case 4:
OPT_settyp = OPT_set32typ;
break;
@ -104,14 +105,44 @@ static void Compiler_PropagateElementaryTypeSizes (void)
}
}
static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len)
{
OPT_Link l = NIL;
CHAR fn[64];
Platform_FileIdentity id;
objectnames[0] = 0x00;
l = OPT_Links;
while (l != NIL) {
__COPY(l->name, fn, 64);
Strings_Append((CHAR*)".sym", 5, (void*)fn, 64);
if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
__COPY(l->name, fn, 64);
Strings_Append((CHAR*)".o", 3, (void*)fn, 64);
if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
Strings_Append((CHAR*)" ", 2, (void*)objectnames, objectnames__len);
Strings_Append(fn, 64, (void*)objectnames, objectnames__len);
} else {
OPM_LogVT100((CHAR*)"91m", 4);
OPM_LogWStr((CHAR*)"Link warning: a local symbol file is present for module ", 57);
OPM_LogWStr(l->name, 256);
OPM_LogWStr((CHAR*)", but local object file '", 26);
OPM_LogWStr(fn, 64);
OPM_LogWStr((CHAR*)"' is missing.", 14);
OPM_LogVT100((CHAR*)"0m", 3);
OPM_LogWLn();
}
}
l = l->next;
}
}
void Compiler_Translate (void)
{
BOOLEAN done;
CHAR modulesobj[2048];
modulesobj[0] = 0x00;
CHAR linkfiles[2048];
if (OPM_OpenPar()) {
for (;;) {
OPM_Init(&done, (void*)Compiler_mname, 256);
OPM_Init(&done);
if (!done) {
return;
}
@ -131,11 +162,9 @@ void Compiler_Translate (void)
} else {
if (!__IN(10, OPM_Options, 32)) {
extTools_Assemble(OPM_modName, 32);
Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
} else {
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
}
}
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -8,7 +8,7 @@
#include "SYSTEM.h"
export CHAR Configuration_versionLong[75];
export CHAR Configuration_versionLong[76];
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
__MOVE("1.95 [2016/11/24]. 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;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Configuration__h
@ -6,7 +6,7 @@
#include "SYSTEM.h"
import CHAR Configuration_versionLong[75];
import CHAR Configuration_versionLong[76];
import void *Configuration__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -26,7 +26,7 @@ typedef
Files_BufDesc *Files_Buffer;
typedef
CHAR Files_FileName[101];
CHAR Files_FileName[256];
typedef
struct Files_FileDesc {
@ -36,7 +36,7 @@ typedef
INT32 fd, len, pos;
Files_Buffer bufs[4];
INT16 swapper, state;
Files_File next;
struct Files_FileDesc *next;
} Files_FileDesc;
typedef
@ -48,11 +48,12 @@ typedef
} Files_Rider;
static Files_File Files_files;
export INT16 Files_MaxPathLength, Files_MaxNameLength;
static Files_FileDesc *Files_files;
static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
LONGINT len[1];
ADDRESS len[1];
CHAR data[1];
} *Files_SearchPath;
@ -60,58 +61,68 @@ export ADDRESS *Files_FileDesc__typ;
export ADDRESS *Files_BufDesc__typ;
export ADDRESS *Files_Rider__typ;
static void Files_Assert (BOOLEAN truth);
export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
export void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
export void Files_Close (Files_File f);
static void Files_CloseOSFile (Files_File f);
static void Files_Create (Files_File f);
export void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode);
export void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
static void Files_Deregister (CHAR *name, ADDRESS name__len);
static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode);
static void Files_Finalize (SYSTEM_PTR o);
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len);
static void Files_Flush (Files_Buffer buf);
export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
export void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len);
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len);
export INT32 Files_Length (Files_File f);
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
export Files_File Files_New (CHAR *name, LONGINT name__len);
export Files_File Files_Old (CHAR *name, LONGINT name__len);
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len);
export Files_File Files_New (CHAR *name, ADDRESS name__len);
export Files_File Files_Old (CHAR *name, ADDRESS name__len);
export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
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_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
export void Files_Register (Files_File f);
export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len);
export void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len);
export void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
export void Files_SetSearchPath (CHAR *path, LONGINT path__len);
export void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
#define Files_IdxTrap() __HALT(-1)
#define Files_ToAdr(x) (ADDRESS)x
static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
static void Files_Assert (BOOLEAN truth)
{
if (!truth) {
Out_Ln();
__ASSERT(truth, 0);
}
}
static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
Out_Ln();
@ -120,17 +131,17 @@ static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
Out_String((CHAR*)": ", 3);
if (f != NIL) {
if (f->registerName[0] != 0x00) {
Out_String(f->registerName, 101);
Out_String(f->registerName, 256);
} else {
Out_String(f->workName, 101);
Out_String(f->workName, 256);
}
if (f->fd != 0) {
Out_String((CHAR*)"f.fd = ", 8);
Out_String((CHAR*)", f.fd = ", 10);
Out_Int(f->fd, 1);
}
}
if (errcode != 0) {
Out_String((CHAR*)" errcode = ", 12);
Out_String((CHAR*)", errcode = ", 13);
Out_Int(errcode, 1);
}
Out_Ln();
@ -138,98 +149,125 @@ static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
__DEL(s);
}
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT 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(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;
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;
while (dir[i] != 0x00) {
dest[i] = dir[i];
i += 1;
}
if (dest[i - 1] != '/') {
dest[i] = '/';
i += 1;
}
while (name[j] != 0x00) {
dest[i] = name[j];
while (j < ln) {
dest[__X(i, dest__len)] = name[__X(j, name__len)];
i += 1;
j += 1;
}
dest[i] = 0x00;
dest[__X(i, dest__len)] = 0x00;
__DEL(dir);
__DEL(name);
}
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT 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);
if (finalName[0] == '/') {
__COPY(finalName, name, name__len);
} else {
Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len);
}
i = Strings_Length(name, name__len) - 1;
while ((i > 0 && name[__X(i, name__len)] != '/')) {
i -= 1;
}
if ((i + 16) >= name__len) {
Files_Err((CHAR*)"File name too long", 19, NIL, 0);
}
Files_tempno += 1;
n = Files_tempno;
i = 0;
if (finalName[0] != '/') {
while (Platform_CWD[i] != 0x00) {
name[i] = Platform_CWD[i];
i += 1;
}
if (Platform_CWD[i - 1] != '/') {
name[i] = '/';
i += 1;
}
}
j = 0;
while (finalName[j] != 0x00) {
name[i] = finalName[j];
i += 1;
j += 1;
}
i -= 1;
while (name[i] != '/') {
i -= 1;
}
name[i + 1] = '.';
name[i + 2] = 't';
name[i + 3] = 'm';
name[i + 4] = 'p';
name[i + 5] = '.';
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;
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);
i += 1;
}
name[i] = '.';
name[__X(i, name__len)] = '.';
i += 1;
n = Platform_PID;
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);
i += 1;
}
name[i] = 0x00;
name[__X(i, name__len)] = 0x00;
__DEL(finalName);
}
static void Files_Deregister (CHAR *name, ADDRESS name__len)
{
Platform_FileIdentity identity;
Files_File osfile = NIL;
INT16 error;
__DUP(name, name__len, CHAR);
if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) {
osfile = (Files_File)Files_files;
while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) {
osfile = (Files_File)osfile->next;
}
if (osfile != NIL) {
__ASSERT(!osfile->tempFile, 0);
__ASSERT(osfile->fd >= 0, 0);
__MOVE(osfile->workName, osfile->registerName, 256);
Files_GetTempName(osfile->registerName, 256, (void*)osfile->workName, 256);
osfile->tempFile = 1;
osfile->state = 0;
error = Platform_Rename((void*)osfile->registerName, 256, (void*)osfile->workName, 256);
if (error != 0) {
Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error);
}
}
}
__DEL(name);
}
static void Files_Create (Files_File f)
{
Platform_FileIdentity identity;
BOOLEAN done;
INT16 error;
CHAR err[32];
if (f->fd == -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;
} else if (f->state == 2) {
__COPY(f->registerName, f->workName, 101);
} else {
__ASSERT(f->state == 2, 0);
Files_Deregister(f->registerName, 256);
__MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
error = Platform_Unlink((void*)f->workName, 101);
error = Platform_New((void*)f->workName, 101, &f->fd);
error = Platform_Unlink((void*)f->workName, 256);
error = Platform_New((void*)f->workName, 256, &f->fd);
done = error == 0;
if (done) {
f->next = Files_files;
@ -275,27 +313,6 @@ static void Files_Flush (Files_Buffer buf)
}
}
static void Files_CloseOSFile (Files_File f)
{
Files_File prev = NIL;
INT16 error;
if (Files_files == f) {
Files_files = f->next;
} else {
prev = Files_files;
while ((prev != NIL && prev->next != f)) {
prev = prev->next;
}
if (prev->next != NIL) {
prev->next = f->next;
}
}
error = Platform_Close(f->fd);
f->fd = -1;
f->state = 1;
Heap_FileCount -= 1;
}
void Files_Close (Files_File f)
{
INT32 i;
@ -303,11 +320,10 @@ void Files_Close (Files_File f)
if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f);
i = 0;
while ((i < 4 && f->bufs[i] != NIL)) {
Files_Flush(f->bufs[i]);
while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) {
Files_Flush(f->bufs[__X(i, 4)]);
i += 1;
}
Files_CloseOSFile(f);
}
}
@ -316,13 +332,13 @@ INT32 Files_Length (Files_File f)
return f->len;
}
Files_File Files_New (CHAR *name, LONGINT name__len)
Files_File Files_New (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc);
f->workName[0] = 0x00;
__COPY(name, f->registerName, 101);
__COPY(name, f->registerName, 256);
f->fd = -1;
f->state = 1;
f->len = 0;
@ -332,7 +348,7 @@ Files_File Files_New (CHAR *name, LONGINT name__len)
return f;
}
static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
{
INT16 i;
CHAR ch;
@ -344,38 +360,38 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
*pos += 1;
}
} else {
ch = (Files_SearchPath->data)[*pos];
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (ch == ' ' || ch == ';') {
*pos += 1;
ch = (Files_SearchPath->data)[*pos];
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
}
if (ch == '~') {
*pos += 1;
ch = (Files_SearchPath->data)[*pos];
while (Files_HOME[i] != 0x00) {
dir[i] = Files_HOME[i];
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (Files_HOME[__X(i, 1024)] != 0x00) {
dir[__X(i, dir__len)] = Files_HOME[__X(i, 1024)];
i += 1;
}
if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) {
while ((i > 0 && dir[i - 1] != '/')) {
while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) {
i -= 1;
}
}
}
while ((ch != 0x00 && ch != ';')) {
dir[i] = ch;
dir[__X(i, dir__len)] = ch;
i += 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;
}
}
dir[i] = 0x00;
dir[__X(i, dir__len)] = 0x00;
}
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -383,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
ch = name[0];
while ((ch != 0x00 && ch != '/')) {
i += 1;
ch = name[i];
ch = name[__X(i, name__len)];
}
return ch == '/';
}
@ -392,15 +408,15 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
Files_File f = NIL;
INT16 i, error;
f = Files_files;
f = (Files_File)Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
if (!Platform_SameFileTime(identity, f->identity)) {
i = 0;
while (i < 4) {
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
}
i += 1;
}
@ -410,12 +426,12 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
}
return f;
}
f = f->next;
f = (Files_File)f->next;
}
return NIL;
}
Files_File Files_Old (CHAR *name, LONGINT name__len)
Files_File Files_Old (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
INT32 fd;
@ -456,6 +472,7 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
error = Platform_Close(fd);
__DEL(name);
return f;
} else {
@ -466,7 +483,7 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
f->pos = 0;
f->swapper = -1;
error = Platform_Size(fd, &f->len);
__COPY(name, f->workName, 101);
__COPY(name, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
f->identity = identity;
@ -498,9 +515,9 @@ void Files_Purge (Files_File f)
INT16 error;
i = 0;
while (i < 4) {
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
}
i += 1;
}
@ -526,7 +543,7 @@ void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
__ASSERT((*r).offset <= 4096, 0);
Files_Assert((*r).offset <= 4096);
return (*r).org + (*r).offset;
}
@ -544,22 +561,22 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
offset = __MASK(pos, -4096);
org = pos - offset;
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;
}
if (i < 4) {
if (f->bufs[i] == NIL) {
if (f->bufs[__X(i, 4)] == NIL) {
__NEW(buf, Files_BufDesc);
buf->chg = 0;
buf->org = -1;
buf->f = f;
f->bufs[i] = buf;
f->bufs[__X(i, 4)] = buf;
} else {
buf = f->bufs[i];
buf = f->bufs[__X(i, 4)];
}
} else {
f->swapper = __MASK(f->swapper + 1, -4);
buf = f->bufs[f->swapper];
buf = f->bufs[__X(f->swapper, 4)];
Files_Flush(buf);
}
if (buf->org != org) {
@ -585,7 +602,7 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
org = 0;
offset = 0;
}
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@ -604,9 +621,9 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
__ASSERT(offset <= buf->size, 0);
Files_Assert(offset <= buf->size);
if (offset < buf->size) {
*x = buf->data[offset];
*x = buf->data[__X(offset, 4096)];
(*r).offset = offset + 1;
} else if ((*r).org + offset < buf->f->len) {
Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset);
@ -618,7 +635,12 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
}
}
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
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)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -644,12 +666,12 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
__MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
__MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
}
(*r).res = 0;
(*r).eof = 0;
@ -666,14 +688,14 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
__ASSERT(offset < 4096, 0);
buf->data[offset] = x;
Files_Assert(offset < 4096);
buf->data[__X(offset, 4096)] = x;
buf->chg = 1;
if (offset == buf->size) {
buf->size += 1;
@ -683,7 +705,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -694,23 +716,23 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
__MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
__MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
offset += min;
(*r).offset = offset;
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@ -722,14 +744,15 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
Files_Deregister(name, name__len);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res)
{
INT32 fdold, fdnew, n;
INT16 error, ignore;
@ -795,31 +818,30 @@ void Files_Register (Files_File f)
{
INT16 idx, errcode;
Files_File f1 = NIL;
CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
f->state = 2;
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
Files_Deregister(f->registerName, 256);
Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
if (errcode != 0) {
__COPY(f->registerName, file, 104);
__HALT(99);
Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
}
__COPY(f->registerName, f->workName, 101);
__MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
__DEL(path);
}
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len)
{
INT32 i, j;
if (!Platform_LittleEndian) {
@ -827,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *de
j = 0;
while (i > 0) {
i -= 1;
dest[j] = src[i];
dest[__X(j, dest__len)] = src[__X(i, src__len)];
j += 1;
}
} else {
@ -877,36 +899,36 @@ void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
CHAR ch;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&ch);
x[i] = ch;
x[__X(i, x__len)] = ch;
i += 1;
} while (!(ch == 0x00));
}
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&x[i]);
Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]);
i += 1;
} while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a));
if (x[i - 1] == 0x0a) {
} while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a));
if (x[__X(i - 1, x__len)] == 0x0a) {
i -= 1;
}
if ((i > 0 && x[i - 1] == 0x0d)) {
if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) {
i -= 1;
}
x[i] = 0x00;
x[__X(i, x__len)] = 0x00;
}
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len)
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
{
INT8 s, b;
INT64 q;
@ -919,7 +941,7 @@ void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__
Files_Read(&*R, R__typ, (void*)&b);
}
q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
__ASSERT(x__len <= 8, 0);
Files_Assert(x__len <= 8);
__MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
}
@ -931,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)
{
CHAR b[2];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[0] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2);
}
void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x)
{
CHAR b[4];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[2] = (CHAR)__ASHR(x, 16);
b[3] = (CHAR)__ASHR(x, 24);
b[0] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
b[2] = __CHR(__ASHR(x, 16));
b[3] = __CHR(__ASHR(x, 24));
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
@ -950,11 +972,13 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{
CHAR b[4];
INT32 i;
i = (INT32)x;
b[0] = (CHAR)i;
b[1] = (CHAR)__ASHR(i, 8);
b[2] = (CHAR)__ASHR(i, 16);
b[3] = (CHAR)__ASHR(i, 24);
UINT64 y;
y = x;
i = __VAL(INT32, y);
b[0] = __CHR(i);
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);
}
@ -972,11 +996,11 @@ void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
i = 0;
while (x[i] != 0x00) {
while (x[__X(i, x__len)] != 0x00) {
i += 1;
}
Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
@ -985,17 +1009,38 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len
void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{
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);
}
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, LONGINT name__len)
void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
{
__COPY(f->workName, name, name__len);
}
static void Files_CloseOSFile (Files_File f)
{
Files_File prev = NIL;
INT16 error;
if (Files_files == (void *) f) {
Files_files = f->next;
} else {
prev = (Files_File)Files_files;
while ((prev != NIL && prev->next != (void *) f)) {
prev = (Files_File)prev->next;
}
if (prev->next != NIL) {
prev->next = f->next;
}
}
error = Platform_Close(f->fd);
f->fd = -1;
f->state = 1;
Heap_FileCount -= 1;
}
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
@ -1004,12 +1049,12 @@ static void Files_Finalize (SYSTEM_PTR o)
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {
res = Platform_Unlink((void*)f->workName, 101);
res = Platform_Unlink((void*)f->workName, 256);
}
}
}
void Files_SetSearchPath (CHAR *path, LONGINT path__len)
void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
@ -1023,11 +1068,10 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
static void EnumPtrs(void (*P)(void*))
{
P(Files_files);
P(Files_SearchPath);
}
__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 252), {228, 232, 236, 240, 248, -24}};
__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_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}};
@ -1047,5 +1091,7 @@ export void *Files__init(void)
Heap_FileCount = 0;
Files_HOME[0] = 0x00;
Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024);
Files_MaxPathLength = Platform_MaxPathLength();
Files_MaxNameLength = Platform_MaxNameLength();
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Files__h
@ -10,9 +10,8 @@ typedef
typedef
struct Files_FileDesc {
char _prvt0[216];
INT32 fd;
char _prvt1[32];
INT32 _prvt0;
char _prvt1[560];
} Files_FileDesc;
typedef
@ -23,46 +22,48 @@ typedef
} Files_Rider;
import INT16 Files_MaxPathLength, Files_MaxNameLength;
import ADDRESS *Files_FileDesc__typ;
import ADDRESS *Files_Rider__typ;
import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
import void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
import void Files_Close (Files_File f);
import void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
import void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
import void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
import void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
import INT32 Files_Length (Files_File f);
import Files_File Files_New (CHAR *name, LONGINT name__len);
import Files_File Files_Old (CHAR *name, LONGINT name__len);
import Files_File Files_New (CHAR *name, ADDRESS name__len);
import Files_File Files_Old (CHAR *name, ADDRESS name__len);
import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
import void Files_Purge (Files_File f);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
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_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void Files_Register (Files_File f);
import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
import void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
import void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
import void Files_SetSearchPath (CHAR *path, LONGINT path__len);
import void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void *Files__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -68,8 +68,10 @@ static INT32 Heap_freeList[10];
static INT32 Heap_bigBlocks;
export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry;
static INT32 Heap_heap, Heap_heapend;
export INT32 Heap_heapsize;
static INT16 Heap_ldUnit;
export INT32 Heap_heap;
static INT32 Heap_heapMin, Heap_heapMax;
export INT32 Heap_heapsize, Heap_heapMinExpand;
static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
@ -84,15 +86,16 @@ static void Heap_CheckFin (void);
static void Heap_ExtendHeap (INT32 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
export INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
export void Heap_GC (BOOLEAN markStack);
static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len);
static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len);
export void Heap_INCREF (Heap_Module m);
export void Heap_InitHeap (void);
export void Heap_Lock (void);
static void Heap_Mark (INT32 q);
static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len);
static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len);
static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len);
export SYSTEM_PTR Heap_NEWBLK (INT32 size);
export SYSTEM_PTR Heap_NEWREC (INT32 tag);
static INT32 Heap_NewChunk (INT32 blksz);
@ -101,16 +104,18 @@ export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
export void Heap_REGTYP (Heap_Module m, INT32 typ);
export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
static void Heap_Scan (void);
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len);
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len);
export void Heap_Unlock (void);
extern void *Heap__init();
extern ADDRESS Platform_MainStackFrame;
extern ADDRESS Modules_MainStackFrame;
extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
#define Heap_ModulesHalt(code) Modules_Halt(code)
#define Heap_ModulesMainStackFrame() Modules_MainStackFrame
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
#define Heap_uLE(x, y) ((size_t)x <= (size_t)y)
#define Heap_uLT(x, y) ((size_t)x < (size_t)y)
void Heap_Lock (void)
{
@ -143,6 +148,35 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
return (void*)m;
}
INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
{
Heap_Module m, p;
__DUP(name, name__len, CHAR);
m = (Heap_Module)(ADDRESS)Heap_modules;
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m;
m = m->next;
}
if ((m != NIL && m->refcnt == 0)) {
if (m == (Heap_Module)(ADDRESS)Heap_modules) {
Heap_modules = (SYSTEM_PTR)m->next;
} else {
p->next = m->next;
}
__DEL(name);
return 0;
} else {
if (m == NIL) {
__DEL(name);
return -1;
} else {
__DEL(name);
return m->refcnt;
}
}
__RETCHK;
}
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
{
Heap_Cmd c;
@ -170,16 +204,24 @@ void Heap_INCREF (Heap_Module m)
static INT32 Heap_NewChunk (INT32 blksz)
{
INT32 chnk;
INT32 chnk, blk, end;
chnk = Heap_OSAllocate(blksz + 12);
if (chnk != 0) {
__PUT(chnk + 4, chnk + (12 + blksz), INT32);
__PUT(chnk + 12, chnk + 16, INT32);
__PUT(chnk + 16, blksz, INT32);
__PUT(chnk + 20, -4, INT32);
__PUT(chnk + 24, Heap_bigBlocks, INT32);
Heap_bigBlocks = chnk + 12;
blk = chnk + 12;
end = blk + blksz;
__PUT(chnk + 4, end, INT32);
__PUT(blk, blk + 4, INT32);
__PUT(blk + 4, blksz, INT32);
__PUT(blk + 8, -4, INT32);
__PUT(blk + 12, Heap_bigBlocks, INT32);
Heap_bigBlocks = blk;
Heap_heapsize += blksz;
if (Heap_uLT(blk + 4, Heap_heapMin)) {
Heap_heapMin = blk + 4;
}
if (Heap_uLT(Heap_heapMax, end)) {
Heap_heapMax = end;
}
}
return chnk;
}
@ -187,29 +229,28 @@ static INT32 Heap_NewChunk (INT32 blksz)
static void Heap_ExtendHeap (INT32 blksz)
{
INT32 size, chnk, j, next;
if (blksz > 160000) {
if (Heap_uLT(Heap_heapMinExpand, blksz)) {
size = blksz;
} else {
size = 160000;
size = Heap_heapMinExpand;
}
chnk = Heap_NewChunk(size);
if (chnk != 0) {
if (chnk < Heap_heap) {
if (Heap_uLT(chnk, Heap_heap)) {
__PUT(chnk, Heap_heap, INT32);
Heap_heap = chnk;
} else {
j = Heap_heap;
__GET(j, next, INT32);
while ((next != 0 && chnk > next)) {
while ((next != 0 && Heap_uLT(next, chnk))) {
j = next;
__GET(j, next, INT32);
}
__PUT(chnk, next, INT32);
__PUT(j, chnk, INT32);
}
if (next == 0) {
__GET(chnk + 4, Heap_heapend, INT32);
}
} else if (!Heap_firstTry) {
Heap_heapMinExpand = 16;
}
}
@ -219,7 +260,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
SYSTEM_PTR new;
Heap_Lock();
__GET(tag, blksz, INT32);
i0 = __ASHR(blksz, 4);
i0 = __LSH(blksz, -Heap_ldUnit, 32);
i = i0;
if (i < 9) {
adr = Heap_freeList[i];
@ -251,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
if (Heap_firstTry) {
Heap_GC(1);
blksz += 16;
if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize);
t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 32) * 80;
if (Heap_uLT(Heap_heapsize, t)) {
Heap_ExtendHeap(t - Heap_heapsize);
}
Heap_firstTry = 0;
new = Heap_NEWREC(tag);
Heap_firstTry = 1;
if (new == NIL) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize);
Heap_ExtendHeap(blksz);
new = Heap_NEWREC(tag);
}
Heap_firstTry = 1;
Heap_Unlock();
return new;
} else {
@ -269,7 +311,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
}
__GET(adr + 4, t, INT32);
if (t >= blksz) {
if (Heap_uLE(blksz, t)) {
break;
}
prev = adr;
@ -280,7 +322,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
__PUT(end + 4, blksz, INT32);
__PUT(end + 8, -4, INT32);
__PUT(end, end + 4, INT32);
if (restsize > 144) {
if (Heap_uLT(144, restsize)) {
__PUT(adr + 4, restsize, INT32);
} else {
__GET(adr + 12, next, INT32);
@ -289,7 +331,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
} else {
__PUT(prev + 12, next, INT32);
}
if (restsize > 0) {
if (restsize != 0) {
di = __ASHR(restsize, 4);
__PUT(adr + 4, restsize, INT32);
__PUT(adr + 12, Heap_freeList[di], INT32);
@ -300,7 +342,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
i = adr + 16;
end = adr + blksz;
while (i < end) {
while (Heap_uLT(i, end)) {
__PUT(i, 0, INT32);
__PUT(i + 4, 0, INT32);
__PUT(i + 8, 0, INT32);
@ -397,17 +439,17 @@ static void Heap_Scan (void)
while (chnk != 0) {
adr = chnk + 12;
__GET(chnk + 4, end, INT32);
while (adr < end) {
while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT32);
if (__ODD(tag)) {
if (freesize > 0) {
if (freesize != 0) {
start = adr - freesize;
__PUT(start, start + 4, INT32);
__PUT(start + 4, freesize, INT32);
__PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4);
i = __LSH(freesize, -Heap_ldUnit, 32);
freesize = 0;
if (i < 9) {
if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@ -426,14 +468,14 @@ static void Heap_Scan (void)
adr += size;
}
}
if (freesize > 0) {
if (freesize != 0) {
start = adr - freesize;
__PUT(start, start + 4, INT32);
__PUT(start + 4, freesize, INT32);
__PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4);
i = __LSH(freesize, -Heap_ldUnit, 32);
freesize = 0;
if (i < 9) {
if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@ -445,18 +487,19 @@ static void Heap_Scan (void)
}
}
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len)
{
INT32 i, j, x;
INT32 i, j;
INT32 x;
j = l;
x = a[j];
for (;;) {
i = j;
j = __ASHL(j, 1) + 1;
if ((j < r && a[j] < a[j + 1])) {
if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
j += 1;
}
if (j > r || a[j] <= x) {
if (j > r || Heap_uLE(a[j], x)) {
break;
}
a[i] = a[j];
@ -464,9 +507,10 @@ static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
a[i] = x;
}
static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len)
{
INT32 l, r, x;
INT32 l, r;
INT32 x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@ -482,37 +526,42 @@ static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
}
}
static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len)
static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len)
{
INT32 chnk, adr, tag, next, lim, lim1, i, ptr, size;
INT32 chnk, end, adr, tag, next, i, ptr, size;
chnk = Heap_heap;
i = 0;
lim = cand[n - 1];
while ((chnk != 0 && chnk < lim)) {
while (chnk != 0) {
__GET(chnk + 4, end, INT32);
adr = chnk + 12;
__GET(chnk + 4, lim1, INT32);
if (lim < lim1) {
lim1 = lim;
}
while (adr < lim1) {
while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT32);
if (__ODD(tag)) {
__GET(tag - 1, size, INT32);
adr += size;
} else {
__GET(tag, size, INT32);
ptr = adr + 4;
while (cand[i] < ptr) {
while (Heap_uLT(cand[i], ptr)) {
i += 1;
}
if (i == n) {
return;
}
next = adr + size;
if (cand[i] < next) {
}
} else {
__GET(tag, size, INT32);
ptr = adr + 4;
adr += size;
while (Heap_uLT(cand[i], ptr)) {
i += 1;
if (i == n) {
return;
}
}
if (Heap_uLT(cand[i], adr)) {
Heap_Mark(ptr);
}
adr = next;
}
if (Heap_uLE(end, cand[i])) {
adr = end;
}
}
__GET(chnk, chnk, INT32);
@ -571,10 +620,11 @@ void Heap_FINALL (void)
}
}
static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len)
{
SYSTEM_PTR frame;
INT32 inc, nofcand, sp, p, stack0;
INT32 nofcand;
INT32 inc, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@ -585,14 +635,14 @@ static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
if (n == 0) {
nofcand = 0;
sp = (ADDRESS)&frame;
stack0 = Heap_PlatformMainStackFrame();
stack0 = Heap_ModulesMainStackFrame();
inc = (ADDRESS)&align.p - (ADDRESS)&align;
if (sp > stack0) {
if (Heap_uLT(stack0, sp)) {
inc = -inc;
}
while (sp != stack0) {
__GET(sp, p, INT32);
if ((p > Heap_heap && p < Heap_heapend)) {
if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
@ -615,7 +665,6 @@ void Heap_GC (BOOLEAN markStack)
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 cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
Heap_Lock();
m = (Heap_Module)(ADDRESS)Heap_modules;
while (m != NIL) {
@ -688,7 +737,6 @@ void Heap_GC (BOOLEAN markStack)
Heap_Finalize();
Heap_Unlock();
}
}
void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
{
@ -703,17 +751,21 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
Heap_heap = Heap_NewChunk(128000);
__GET(Heap_heap + 4, Heap_heapend, INT32);
__PUT(Heap_heap, 0, INT32);
Heap_heap = 0;
Heap_heapsize = 0;
Heap_allocated = 0;
Heap_lockdepth = 0;
Heap_heapMin = -1;
Heap_heapMax = 0;
Heap_bigBlocks = 0;
Heap_heapMinExpand = 128000;
Heap_ldUnit = 4;
Heap_heap = Heap_NewChunk(128000);
__PUT(Heap_heap, 0, INT32);
Heap_firstTry = 1;
Heap_freeList[9] = 1;
Heap_lockdepth = 0;
Heap_FileCount = 0;
Heap_modules = NIL;
Heap_heapsize = 0;
Heap_bigBlocks = 0;
Heap_fin = NIL;
Heap_interrupted = 0;
Heap_HeapModuleInit();

View file

@ -1,16 +1,26 @@
/* voc 1.95 [2016/11/24]. 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
#define Heap__h
#include "SYSTEM.h"
typedef
struct Heap_CmdDesc *Heap_Cmd;
typedef
CHAR Heap_CmdName[24];
typedef
void (*Heap_Command)(void);
typedef
struct Heap_CmdDesc {
Heap_Cmd next;
Heap_CmdName name;
Heap_Command cmd;
} Heap_CmdDesc;
typedef
void (*Heap_EnumProc)(void(*)(SYSTEM_PTR));
@ -21,22 +31,31 @@ typedef
struct Heap_ModuleDesc *Heap_Module;
typedef
struct Heap_ModuleDesc {
INT32 _prvt0;
char _prvt1[44];
} Heap_ModuleDesc;
CHAR Heap_ModuleName[20];
typedef
CHAR Heap_ModuleName[20];
struct Heap_ModuleDesc {
Heap_Module next;
Heap_ModuleName name;
INT32 refcnt;
Heap_Cmd cmds;
INT32 types;
Heap_EnumProc enumPtrs;
char _prvt0[8];
} Heap_ModuleDesc;
import SYSTEM_PTR Heap_modules;
import INT32 Heap_allocated, Heap_heapsize;
import INT32 Heap_allocated;
import INT32 Heap_heap;
import INT32 Heap_heapsize, Heap_heapMinExpand;
import INT16 Heap_FileCount;
import ADDRESS *Heap_ModuleDesc__typ;
import ADDRESS *Heap_CmdDesc__typ;
import void Heap_FINALL (void);
import INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -9,81 +9,303 @@
#include "Heap.h"
#include "Platform.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
typedef
void (*Modules_Command)(void);
typedef
struct Modules_CmdDesc {
Modules_Cmd next;
CHAR name[24];
Modules_Command cmd;
} Modules_CmdDesc;
typedef
struct Modules_ModuleDesc *Modules_Module;
typedef
CHAR Modules_ModuleName[20];
typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
INT32 refcnt;
Modules_Cmd cmds;
INT32 types;
void (*enumPtrs)(void(*)(INT32));
INT32 reserved1, reserved2;
} Modules_ModuleDesc;
export INT16 Modules_res;
export CHAR Modules_resMsg[256];
export Modules_ModuleName Modules_imported, Modules_importing;
export Heap_ModuleName Modules_imported, Modules_importing;
export INT32 Modules_MainStackFrame;
export INT16 Modules_ArgCount;
export INT32 Modules_ArgVector;
export CHAR Modules_BinaryDir[1024];
export ADDRESS *Modules_ModuleDesc__typ;
export ADDRESS *Modules_CmdDesc__typ;
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
export INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
export void Modules_AssertFail (INT32 code);
static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len);
static void Modules_DisplayHaltCode (INT32 code);
export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len);
static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len);
export void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
export void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
export void Modules_GetIntArg (INT16 n, INT32 *val);
export void Modules_Halt (INT32 code);
export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
export void Modules_Init (INT32 argc, INT32 argvadr);
static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len);
static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len);
static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len);
export Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
export Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static void Modules_errch (CHAR c);
static void Modules_errint (INT32 l);
static void Modules_errstring (CHAR *s, LONGINT s__len);
static void Modules_errstring (CHAR *s, ADDRESS s__len);
#define Modules_modules() (Modules_Module)Heap_modules
#define Modules_setmodules(m) Heap_modules = m
extern void Heap_InitHeap();
extern void *Modules__init(void);
#define Modules_InitHeap() Heap_InitHeap()
#define Modules_ModulesInit() Modules__init()
#define Modules_modules() (Heap_Module)Heap_modules
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
void Modules_Init (INT32 argc, INT32 argvadr)
{
INT16 i, j;
__DUP(b, b__len, CHAR);
Modules_MainStackFrame = argvadr;
Modules_ArgCount = __VAL(INT16, argc);
__GET(argvadr, Modules_ArgVector, INT32);
Modules_InitHeap();
Modules_ModulesInit();
}
typedef
CHAR (*argptr__15)[1024];
void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len)
{
argptr__15 arg = NIL;
if (n < Modules_ArgCount) {
__GET(Modules_ArgVector + __ASHL(n, 2), arg, argptr__15);
__COPY(*arg, val, val__len);
}
}
void Modules_GetIntArg (INT16 n, INT32 *val)
{
CHAR s[64];
INT32 k, d, i;
s[0] = 0x00;
Modules_GetArg(n, (void*)s, 64);
i = 0;
while (a[__X(i, a__len)] != 0x00) {
if (s[0] == '-') {
i = 1;
}
k = 0;
d = (INT16)s[__X(i, 64)] - 48;
while ((d >= 0 && d <= 9)) {
k = k * 10 + d;
i += 1;
d = (INT16)s[__X(i, 64)] - 48;
}
if (s[0] == '-') {
k = -k;
i -= 1;
}
if (i > 0) {
*val = k;
}
}
INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
{
INT16 i;
CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0;
Modules_GetArg(i, (void*)arg, 256);
while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1;
Modules_GetArg(i, (void*)arg, 256);
}
__DEL(s);
return i;
}
static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
i = 0;
while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
j = 0;
while (b[__X(j, b__len)] != 0x00) {
a[__X(i, a__len)] = b[__X(j, b__len)];
__DEL(s);
return i;
}
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0;
j = Modules_CharCount(d, d__len);
while (s[__X(i, s__len)] != 0x00) {
d[__X(j, d__len)] = s[__X(i, s__len)];
i += 1;
j += 1;
}
a[__X(i, a__len)] = 0x00;
__DEL(b);
d[__X(j, d__len)] = 0x00;
__DEL(s);
}
Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
Modules_Module m = NIL;
INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0;
j = Modules_CharCount(d, d__len);
if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
d[__X(j, d__len)] = c;
j += 1;
}
while (s[__X(i, s__len)] != 0x00) {
d[__X(j, d__len)] = s[__X(i, s__len)];
i += 1;
j += 1;
}
d[__X(j, d__len)] = 0x00;
__DEL(s);
}
static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
if (c == 0x00) {
__DEL(s);
return 0;
}
i = 0;
while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
__DEL(s);
return s[__X(i, s__len)] == c;
}
static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
{
__DUP(d, d__len, CHAR);
if (d[0] == 0x00) {
__DEL(d);
return 0;
}
if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
__DEL(d);
return 1;
}
if (d[__X(1, d__len)] == ':') {
__DEL(d);
return 1;
}
__DEL(d);
return 0;
}
static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
__DUP(s, s__len, CHAR);
if (Modules_IsAbsolute(s, s__len)) {
__COPY(s, d, d__len);
} else {
__COPY(Platform_CWD, d, d__len);
Modules_AppendPart('/', s, s__len, (void*)d, d__len);
}
__DEL(s);
}
static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
{
Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__DEL(s);
return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
}
static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
{
INT16 j;
__DUP(s, s__len, CHAR);
__DUP(p, p__len, CHAR);
j = 0;
while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
d[__X(j, d__len)] = s[__X(*i, s__len)];
*i += 1;
j += 1;
}
d[__X(j, d__len)] = 0x00;
while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
*i += 1;
}
__DEL(s);
__DEL(p);
}
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
INT16 i, j;
CHAR part[1024];
__DUP(s, s__len, CHAR);
i = 0;
j = 0;
while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
i += 1;
d[__X(j, d__len)] = '/';
j += 1;
}
d[__X(j, d__len)] = 0x00;
while (s[__X(i, s__len)] != 0x00) {
Modules_ExtractPart(s, s__len, &i, (CHAR*)"/\\", 3, (void*)part, 1024);
if ((part[0] != 0x00 && __STRCMP(part, ".") != 0)) {
Modules_AppendPart('/', part, 1024, (void*)d, d__len);
}
}
__DEL(s);
}
typedef
CHAR pathstring__12[4096];
static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len)
{
pathstring__12 arg0, pathlist, pathdir, tempstr;
INT16 i, j, k;
BOOLEAN present;
if (Modules_ArgCount < 1) {
binarydir[0] = 0x00;
return;
}
Modules_GetArg(0, (void*)arg0, 4096);
i = 0;
while ((((arg0[__X(i, 4096)] != 0x00 && arg0[__X(i, 4096)] != '/')) && arg0[__X(i, 4096)] != '\\')) {
i += 1;
}
if (arg0[__X(i, 4096)] == '/' || arg0[__X(i, 4096)] == '\\') {
Modules_Trim(arg0, 4096, (void*)tempstr, 4096);
Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
present = Modules_IsFilePresent(binarydir, binarydir__len);
} else {
Platform_GetEnv((CHAR*)"PATH", 5, (void*)pathlist, 4096);
i = 0;
present = 0;
while ((!present && pathlist[__X(i, 4096)] != 0x00)) {
Modules_ExtractPart(pathlist, 4096, &i, (CHAR*)":;", 3, (void*)pathdir, 4096);
Modules_AppendPart('/', arg0, 4096, (void*)pathdir, 4096);
Modules_Trim(pathdir, 4096, (void*)tempstr, 4096);
Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
present = Modules_IsFilePresent(binarydir, binarydir__len);
}
}
if (present) {
k = Modules_CharCount(binarydir, binarydir__len);
while ((k > 0 && !Modules_IsOneOf(binarydir[__X(k - 1, binarydir__len)], (CHAR*)"/\\", 3))) {
k -= 1;
}
if (k == 0) {
binarydir[__X(k, binarydir__len)] = 0x00;
} else {
binarydir[__X(k - 1, binarydir__len)] = 0x00;
}
} else {
binarydir[0] = 0x00;
}
}
Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
{
Heap_Module m = NIL;
CHAR bodyname[64];
Modules_Command body;
Heap_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
@ -96,16 +318,16 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_res = 1;
__COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
Modules_Append((void*)Modules_resMsg, 256, name, name__len);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
}
__DEL(name);
return m;
}
Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
{
Modules_Cmd c = NIL;
Heap_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) {
@ -120,43 +342,36 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
__COPY(name, Modules_importing, 20);
Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
Modules_Append((void*)Modules_resMsg, 256, name, name__len);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
Modules_Append(mod->name, 20, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
__DEL(name);
return NIL;
}
__RETCHK;
}
void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
{
Modules_Module m = NIL, p = NIL;
Heap_Module m = NIL, p = NIL;
INT32 refcount;
__DUP(name, name__len, CHAR);
m = Modules_modules();
if (all) {
Modules_res = 1;
__MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
} else {
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m;
m = m->next;
}
if ((m != NIL && m->refcnt == 0)) {
if (m == Modules_modules()) {
Modules_setmodules(m->next);
} else {
p->next = m->next;
}
refcount = Heap_FreeModule(name, name__len);
if (refcount == 0) {
Modules_res = 0;
} else {
Modules_res = 1;
if (m == NIL) {
if (refcount < 0) {
__MOVE("module not found", Modules_resMsg, 17);
} else {
__MOVE("clients of this module exist", Modules_resMsg, 29);
}
Modules_res = 1;
}
}
__DEL(name);
@ -168,7 +383,7 @@ static void Modules_errch (CHAR c)
e = Platform_Write(1, (ADDRESS)&c, 1);
}
static void Modules_errstring (CHAR *s, LONGINT s__len)
static void Modules_errstring (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@ -189,7 +404,7 @@ static void Modules_errint (INT32 l)
if (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)
@ -250,6 +465,7 @@ static void Modules_DisplayHaltCode (INT32 code)
void Modules_Halt (INT32 code)
{
Heap_FINALL();
Modules_errstring((CHAR*)"Terminated by Halt(", 20);
Modules_errint(code);
Modules_errstring((CHAR*)"). ", 4);
@ -262,6 +478,7 @@ void Modules_Halt (INT32 code)
void Modules_AssertFail (INT32 code)
{
Heap_FINALL();
Modules_errstring((CHAR*)"Assertion failure.", 19);
if (code != 0) {
Modules_errstring((CHAR*)" ASSERT code ", 14);
@ -269,11 +486,13 @@ void Modules_AssertFail (INT32 code)
Modules_errstring((CHAR*)".", 2);
}
Modules_errstring(Platform_NL, 3);
if (code > 0) {
Platform_Exit(code);
} else {
Platform_Exit(-1);
}
}
__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 48), {0, 28, -12}};
__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 32), {0, -8}};
export void *Modules__init(void)
{
@ -281,8 +500,7 @@ export void *Modules__init(void)
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
__INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
__INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
/* BEGIN */
Modules_FindBinaryDir((void*)Modules_BinaryDir, 1024);
__ENDMOD;
}

View file

@ -1,53 +1,30 @@
/* voc 1.95 [2016/11/24]. 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
#define Modules__h
#include "SYSTEM.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
typedef
void (*Modules_Command)(void);
typedef
struct Modules_CmdDesc {
Modules_Cmd next;
CHAR name[24];
Modules_Command cmd;
} Modules_CmdDesc;
typedef
struct Modules_ModuleDesc *Modules_Module;
typedef
CHAR Modules_ModuleName[20];
typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
INT32 refcnt;
Modules_Cmd cmds;
INT32 types;
void (*enumPtrs)(void(*)(INT32));
char _prvt0[8];
} Modules_ModuleDesc;
#include "Heap.h"
import INT16 Modules_res;
import CHAR Modules_resMsg[256];
import Modules_ModuleName Modules_imported, Modules_importing;
import Heap_ModuleName Modules_imported, Modules_importing;
import INT32 Modules_MainStackFrame;
import INT16 Modules_ArgCount;
import INT32 Modules_ArgVector;
import CHAR Modules_BinaryDir[1024];
import ADDRESS *Modules_ModuleDesc__typ;
import ADDRESS *Modules_CmdDesc__typ;
import INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
import void Modules_AssertFail (INT32 code);
import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
import void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
import void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
import void Modules_GetIntArg (INT16 n, INT32 *val);
import void Modules_Halt (INT32 code);
import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
import void Modules_Init (INT32 argc, INT32 argvadr);
import Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
import Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
import void *Modules__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -253,7 +253,7 @@ OPT_Node OPB_NewString (OPS_String str, INT64 len)
x->conval->intval = -1;
x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
__COPY(str, *x->conval->ext, 256);
__MOVE(str, *x->conval->ext, 256);
return x;
}
@ -261,7 +261,7 @@ static void OPB_CharToString (OPT_Node n)
{
CHAR ch;
n->typ = OPT_stringtyp;
ch = (CHAR)n->conval->intval;
ch = __CHR(n->conval->intval);
n->conval->ext = OPT_NewExt();
if (ch == 0x00) {
n->conval->intval2 = 1;
@ -550,7 +550,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
if (f == 4) {
if (z->conval->intval == (-9223372036854775807-1)) {
if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
@ -577,7 +577,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
if (f == 4) {
if (z->conval->intval == (-9223372036854775807-1)) {
if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = __ABS(z->conval->intval);
@ -597,7 +597,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
case 22:
if (f == 3) {
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;
} else {
z = NewOp__29(op, typ, z);
@ -920,7 +920,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
if (f == 4) {
xv = xval->intval;
yv = yval->intval;
if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807LL, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807LL-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807LL-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807LL-1))) && yv != (-9223372036854775807LL-1))) && -xv <= __DIV(9223372036854775807LL, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
@ -999,8 +999,8 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 6:
if (f == 4) {
temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807LL - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
@ -1023,7 +1023,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 7:
if (f == 4) {
if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203);
r = (LONGREAL)1;
}
(*x)->conval->intval = (INT32)__ENTIER(r);
(*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL);
OPB_SetIntType(*x);
}
}
@ -1624,23 +1624,20 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
g = 8;
}
if (x == y) {
} else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) {
} else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) {
OPB_err(113);
} else if (x->BaseTyp == OPT_chartyp) {
if (g == 8) {
if (ynode->conval->intval2 > x->n) {
OPB_err(114);
}
} else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
} else {
OPB_err(113);
}
} else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
} else if (x->comp == 4) {
if (x == y) {
} else if (y->comp == 4) {
@ -2091,7 +2088,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, (INT64)__ASH(1, x->conval->intval))) {
if (__ABS(p->conval->intval) <= __DIV(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
} else {
OPB_err(208);
@ -2536,7 +2533,6 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@ -2562,13 +2558,8 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
y->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(0));
}
if ((((((__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c, 32))) && y->typ->BaseTyp == OPT_chartyp)) {
subcl = 18;
} else {
subcl = 0;
}
OPB_BindNodes(19, OPT_notyp, &*x, y);
(*x)->subcl = subcl;
(*x)->subcl = 0;
}
void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
@ -2595,7 +2586,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
OPB_maxExp = OPB_log(4611686018427387904);
OPB_maxExp = OPB_log(4611686018427387904LL);
OPB_maxExp = OPB_exp;
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPB__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -56,7 +56,7 @@ static void OPC_GenHeaderMsg (void);
export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
static void OPC_IdentList (OPT_Object obj, INT16 vis);
static void OPC_Include (CHAR *name, LONGINT name__len);
static void OPC_Include (CHAR *name, ADDRESS name__len);
static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
export void OPC_Indent (INT16 count);
@ -68,11 +68,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
export void OPC_IntLiteral (INT64 n, INT32 size);
export void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName);
static INT16 OPC_Length (CHAR *s, LONGINT s__len);
static INT16 OPC_Length (CHAR *s, ADDRESS s__len);
export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
export INT32 OPC_NofPtrs (OPT_Struct typ);
static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
@ -80,8 +80,8 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l);
static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
@ -137,7 +137,7 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
{
CHAR ch;
INT16 i;
@ -156,7 +156,7 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
__DEL(s);
}
static INT16 OPC_Length (CHAR *s, LONGINT s__len)
static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@ -166,7 +166,7 @@ static INT16 OPC_Length (CHAR *s, LONGINT s__len)
return i;
}
static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
{
INT16 i, h;
i = 0;
@ -364,7 +364,7 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
OPC_Str1((CHAR*)"ADDRESS len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
@ -511,7 +511,7 @@ static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamNa
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
OPM_WriteString((CHAR*)", LONGINT ", 11);
OPM_WriteString((CHAR*)", ADDRESS ", 11);
} else {
OPM_WriteString((CHAR*)", ", 3);
}
@ -618,7 +618,8 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
{
if (obj != NIL) {
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))) {
if (OPM_currFile == 1 || (OPM_currFile == 0 && obj->vis == 1)) {
OPM_WriteString((CHAR*)"#define __", 11);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
@ -644,6 +645,7 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
OPM_Write(')');
OPM_WriteLn();
}
}
OPC_DefineTProcMacros(obj->right, &*empty);
}
}
@ -652,7 +654,7 @@ static void OPC_DefineType (OPT_Struct str)
{
OPT_Object obj = NIL, field = NIL, par = NIL;
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;
if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) {
@ -681,6 +683,10 @@ static void OPC_DefineType (OPT_Struct str)
OPC_DefineType(str->BaseTyp);
}
} 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);
} else if (str->form == 12) {
if (str->BaseTyp != OPT_notyp) {
@ -715,12 +721,19 @@ static void OPC_DefineType (OPT_Struct str)
if (!empty) {
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();
}
}
}
}
}
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
{
INT16 i;
__DUP(y, y__len, CHAR);
@ -968,8 +981,8 @@ static void OPC_IdentList (OPT_Object obj, INT16 vis)
if (obj->typ->comp == 3) {
OPC_EndStat();
OPC_BegStat();
base = OPT_linttyp;
OPM_WriteString((CHAR*)"LONGINT ", 9);
base = OPT_adrtyp;
OPM_WriteString((CHAR*)"ADDRESS ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
@ -1008,7 +1021,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
__COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
OPM_WriteString((CHAR*)", LONGINT ", 11);
OPM_WriteString((CHAR*)", ADDRESS ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPM_WriteString((CHAR*)", ADDRESS *", 12);
@ -1062,7 +1075,7 @@ static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
}
}
static void OPC_Include (CHAR *name, LONGINT name__len)
static void OPC_Include (CHAR *name, ADDRESS name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", 10);
@ -1138,7 +1151,7 @@ static void OPC_GenHeaderMsg (void)
OPM_WriteString((CHAR*)"/* ", 4);
OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, 75);
OPM_WriteString(Configuration_versionLong, 76);
OPM_Write(' ');
i = 0;
while (i <= 31) {
@ -1659,9 +1672,9 @@ void OPC_CompleteIdent (OPT_Object obj)
OPC_Ident(obj);
OPM_WriteString((CHAR*)"__", 3);
} else {
OPM_WriteString((CHAR*)"((", 3);
OPM_WriteString((CHAR*)"(*(", 4);
OPC_Ident(obj->typ->strobj);
OPM_Write(')');
OPM_WriteString((CHAR*)"*)&", 4);
OPC_Ident(obj);
OPM_Write(')');
}
@ -1739,12 +1752,12 @@ static void OPC_CharacterLiteral (INT64 c)
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write(__CHR(c));
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
{
INT32 i;
INT16 c;
@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
OPM_Write(__CHR(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
OPM_Write(__CHR(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c));
OPM_Write(__CHR(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write(__CHR(c));
}
i += 1;
}
@ -1830,6 +1843,12 @@ void OPC_IntLiteral (INT64 n, INT32 size)
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) {
OPC_CompleteIdent(obj);
OPM_WriteString((CHAR*)"__len", 6);
@ -1837,10 +1856,6 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
OPM_WriteInt(dim);
}
} else {
while (dim > 0) {
array = array->BaseTyp;
dim -= 1;
}
OPM_WriteInt(array->n);
}
}
@ -1912,9 +1927,9 @@ static struct InitKeywords__46 {
struct InitKeywords__46 *lnk;
} *InitKeywords__46_s;
static void Enter__47 (CHAR *s, LONGINT s__len);
static void Enter__47 (CHAR *s, ADDRESS s__len);
static void Enter__47 (CHAR *s, LONGINT s__len)
static void Enter__47 (CHAR *s, ADDRESS s__len)
{
INT16 h;
__DUP(s, s__len, CHAR);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPC__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -8,6 +8,7 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@ -18,6 +19,8 @@ typedef
CHAR OPM_FileName[32];
static CHAR OPM_currentComment[256];
static BOOLEAN OPM_hasComment;
static CHAR OPM_SourceFileName[256];
static CHAR OPM_GlobalModel[10];
export CHAR OPM_Model[10];
@ -26,7 +29,7 @@ export INT16 OPM_AddressSize;
static INT16 OPM_GlobalAlignment;
export INT16 OPM_Alignment;
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 LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
@ -41,41 +44,48 @@ static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
static INT16 OPM_S;
export CHAR OPM_InstallDir[1024];
export CHAR OPM_ResourceDir[1024];
static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
export void OPM_DeleteNewSym (void);
export void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_FPrint (INT32 *fp, INT64 val);
export void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
export void OPM_FPrintReal (INT32 *fp, REAL val);
export void OPM_FPrintSet (INT32 *fp, UINT64 val);
static void OPM_FindInstallDir (void);
static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch);
export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
export void OPM_GetComment (CHAR *text, ADDRESS text__len);
export void OPM_Init (BOOLEAN *done);
export void OPM_InitOptions (void);
export INT16 OPM_Integer (INT64 n);
static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len);
export void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
static void OPM_LogErrMsg (INT16 n);
export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
export void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
export void OPM_LogWNum (INT64 i, INT64 len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
export void OPM_LogWStr (CHAR *s, ADDRESS s__len);
export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
export void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
export void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
static void OPM_ScanOptions (CHAR *s, LONGINT s__len);
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len);
static void OPM_ShowLine (INT64 pos);
export INT64 OPM_SignedMaximum (INT32 bytecount);
export INT64 OPM_SignedMinimum (INT32 bytecount);
export void OPM_StoreComment (CHAR *text, ADDRESS text__len);
export void OPM_SymRCh (CHAR *ch);
export INT32 OPM_SymRInt (void);
export INT64 OPM_SymRInt64 (void);
@ -87,14 +97,13 @@ export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
export void OPM_SymWSet (UINT64 s);
static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
export void OPM_WriteHex (INT64 i);
export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export void OPM_WriteString (CHAR *s, ADDRESS s__len);
export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);
@ -105,7 +114,7 @@ void OPM_LogW (CHAR ch)
Out_Char(ch);
}
void OPM_LogWStr (CHAR *s, LONGINT s__len)
void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{
__DUP(s, s__len, CHAR);
Out_String(s, s__len);
@ -122,7 +131,7 @@ void OPM_LogWLn (void)
Out_Ln();
}
void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
@ -131,6 +140,57 @@ void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
__DEL(vt100code);
}
void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
{
__DUP(modname, modname__len, CHAR);
OPM_LogWStr((CHAR*)"Compiling ", 11);
OPM_LogWStr(modname, modname__len);
if (__IN(18, OPM_Options, 32)) {
OPM_LogWStr((CHAR*)", s:", 5);
OPM_LogWNum(__ASHL(OPM_ShortintSize, 3), 1);
OPM_LogWStr((CHAR*)" i:", 4);
OPM_LogWNum(__ASHL(OPM_IntegerSize, 3), 1);
OPM_LogWStr((CHAR*)" l:", 4);
OPM_LogWNum(__ASHL(OPM_LongintSize, 3), 1);
OPM_LogWStr((CHAR*)" adr:", 6);
OPM_LogWNum(__ASHL(OPM_AddressSize, 3), 1);
OPM_LogWStr((CHAR*)" algn:", 7);
OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
}
OPM_LogW('.');
__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 result;
@ -154,7 +214,7 @@ INT16 OPM_Integer (INT64 n)
return __VAL(INT16, n);
}
static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@ -227,29 +287,6 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
i += 2;
}
break;
case 'B':
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
}
__ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
__ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
__ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
if (OPM_IntegerSize == 2) {
OPM_LongintSize = 4;
} else {
OPM_LongintSize = 8;
}
Files_SetSearchPath((CHAR*)"", 1);
break;
default:
OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
@ -266,16 +303,19 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
BOOLEAN OPM_OpenPar (void)
{
CHAR s[256];
if (Platform_ArgCount == 1) {
if (Modules_ArgCount == 1) {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
OPM_LogWStr(Configuration_versionLong, 75);
OPM_LogWStr(Configuration_versionLong, 76);
OPM_LogW('.');
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Further development by Norayr Chilingarian, David Brown and others.", 68);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Loaded from ", 13);
OPM_LogWStr(Modules_BinaryDir, 1024);
OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
@ -332,7 +372,7 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn();
OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
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_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn();
@ -362,64 +402,38 @@ BOOLEAN OPM_OpenPar (void)
OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
}
OPM_GlobalAddressSize = OPM_AddressSize;
OPM_GlobalAlignment = OPM_Alignment;
__COPY(OPM_Model, OPM_GlobalModel, 10);
__MOVE(OPM_Model, OPM_GlobalModel, 10);
OPM_GlobalOptions = OPM_Options;
return 1;
}
__RETCHK;
}
static void OPM_VerboseListSizes (void)
{
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Type Size", 15);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SHORTINT ", 12);
OPM_LogWNum(OPM_ShortintSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"INTEGER ", 12);
OPM_LogWNum(OPM_IntegerSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"LONGINT ", 12);
OPM_LogWNum(OPM_LongintSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SET ", 12);
OPM_LogWNum(OPM_LongintSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"ADDRESS ", 12);
OPM_LogWNum(OPM_AddressSize, 4);
OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Alignment: ", 12);
OPM_LogWNum(OPM_Alignment, 4);
OPM_LogWLn();
}
void OPM_InitOptions (void)
{
CHAR s[256];
CHAR searchpath[1024], modules[1024];
CHAR MODULES[1024];
OPM_Options = OPM_GlobalOptions;
__COPY(OPM_GlobalModel, OPM_Model, 10);
__MOVE(OPM_GlobalModel, OPM_Model, 10);
OPM_Alignment = OPM_GlobalAlignment;
OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
}
if (__IN(15, OPM_Options, 32)) {
OPM_Options |= __SETOF(10,32);
@ -430,29 +444,32 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
case 'C':
OPM_ShortintSize = 2;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 4;
break;
case 'V':
OPM_ShortintSize = 1;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 8;
break;
default:
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
}
if (__IN(18, OPM_Options, 32)) {
OPM_VerboseListSizes();
}
OPM_ResourceDir[0] = 0x00;
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
if (OPM_ResourceDir[0] != 0x00) {
Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
}
modules[0] = 0x00;
Platform_GetEnv((CHAR*)"MODULES", 8, (void*)modules, 1024);
__MOVE(".", searchpath, 2);
@ -465,23 +482,22 @@ void OPM_InitOptions (void)
Files_SetSearchPath(searchpath, 1024);
}
void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
void OPM_Init (BOOLEAN *done)
{
Texts_Text T = NIL;
INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
if (OPM_S >= Platform_ArgCount) {
if (OPM_S >= Modules_ArgCount) {
return;
}
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
Texts_Open(T, s, 256);
OPM_LogWStr(s, 256);
OPM_LogWStr((CHAR*)" ", 3);
__COPY(s, mname, mname__len);
__COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
OPM_LogWStr(s, 256);
@ -503,18 +519,14 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
void OPM_Get (CHAR *ch)
{
Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
if (*ch == 0x0d) {
OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
} else {
OPM_curpos += 1;
}
Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
if ((*ch < 0x09 && !OPM_inR.eot)) {
*ch = ' ';
}
}
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
{
INT16 i, j;
CHAR ch;
@ -632,7 +644,7 @@ static void OPM_ShowLine (INT64 pos)
if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1;
}
i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768);
while (i > 0) {
OPM_LogW(' ');
i -= 1;
@ -640,7 +652,6 @@ static void OPM_ShowLine (INT64 pos)
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
OPM_LogVT100((CHAR*)"0m", 3);
Files_Close(f);
}
void OPM_Mark (INT16 n, INT32 pos)
@ -700,7 +711,7 @@ void OPM_err (INT16 n)
OPM_Mark(n, OPM_errpos);
}
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
{
INT16 i;
INT32 l;
@ -772,10 +783,13 @@ void OPM_CloseOldSym (void)
Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
{
CHAR tag, ver;
OPM_FileName fileName;
INT16 res;
OPM_oldSFile = NIL;
*done = 0;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
@ -783,8 +797,10 @@ void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
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*)&ver);
if (tag != 0xf7 || ver != 0x82) {
if (tag != 0xf7 || ver != 0x84) {
if (!__IN(4, OPM_Options, 32)) {
OPM_err(-306);
}
OPM_CloseOldSym();
*done = 0;
}
@ -828,11 +844,23 @@ void OPM_RegisterNewSym (void)
}
}
void OPM_DeleteNewSym (void)
void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
{
OPM_FileName fn;
INT16 res;
OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
Files_Delete(fn, 32, &res);
}
void OPM_NewSym (CHAR *modName, LONGINT modName__len)
void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len)
{
OPM_FileName fn;
INT16 res;
OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".o", 3);
Files_Delete(fn, 32, &res);
}
void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
{
OPM_FileName fileName;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
@ -840,7 +868,7 @@ void OPM_NewSym (CHAR *modName, LONGINT modName__len)
if (OPM_newSFile != NIL) {
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, 0x82);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
} else {
OPM_err(153);
}
@ -851,7 +879,7 @@ void OPM_Write (CHAR ch)
Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
void OPM_WriteString (CHAR *s, LONGINT s__len)
void OPM_WriteString (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@ -861,7 +889,7 @@ void OPM_WriteString (CHAR *s, LONGINT s__len)
Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@ -875,17 +903,17 @@ void OPM_WriteHex (INT64 i)
{
CHAR s[3];
INT32 digit;
digit = __ASHR((INT32)i, 4);
digit = __ASHR(__SHORT(i, 2147483648LL), 4);
if (digit < 10) {
s[0] = (CHAR)(48 + digit);
s[0] = __CHR(48 + digit);
} 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) {
s[1] = (CHAR)(48 + digit);
s[1] = __CHR(48 + digit);
} else {
s[1] = (CHAR)(87 + digit);
s[1] = __CHR(87 + digit);
}
s[2] = 0x00;
OPM_WriteString(s, 3);
@ -893,7 +921,7 @@ void OPM_WriteHex (INT64 i)
void OPM_WriteInt (INT64 i)
{
CHAR s[24];
CHAR s[26];
INT64 i1, k;
if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
@ -901,21 +929,27 @@ void OPM_WriteInt (INT64 i)
OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
s[0] = (CHAR)(__MOD(i1, 10) + 48);
if (i1 <= 2147483647) {
k = 0;
} else {
__MOVE("LL", s, 3);
k = 2;
}
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k = 1;
k += 1;
while (i1 > 0) {
s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
s[__X(k, 24)] = '-';
s[__X(k, 26)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
OPM_Write(s[__X(k, 24)]);
OPM_Write(s[__X(k, 26)]);
}
}
}
@ -928,13 +962,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
CHAR s[32];
CHAR ch;
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') {
OPM_WriteString((CHAR*)"(REAL)", 7);
} else {
OPM_WriteString((CHAR*)"(LONGREAL)", 11);
}
OPM_WriteInt((INT32)__ENTIER(r));
OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {
@ -986,9 +1020,9 @@ static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
}
}
void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
{
CHAR FName[32];
OPM_FileName FName;
__COPY(moduleName, OPM_modName, 32);
OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
@ -1014,7 +1048,7 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
CHAR FName[32];
OPM_FileName FName;
INT16 res;
if (OPM_noerr) {
OPM_LogWStr((CHAR*)" ", 3);
@ -1050,6 +1084,59 @@ void OPM_CloseFiles (void)
Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
{
CHAR testpath[4096];
Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0;
}
__COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0;
}
__COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0;
}
__DEL(s);
return 1;
}
static void OPM_FindInstallDir (void)
{
INT16 i;
__COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
Strings_Append((CHAR*)"/", 2, (void*)OPM_InstallDir, 1024);
Strings_Append((CHAR*)"voc", 4, (void*)OPM_InstallDir, 1024);
Strings_Append((CHAR*)".d", 3, (void*)OPM_InstallDir, 1024);
if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
return;
}
__COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
i = Strings_Length(OPM_InstallDir, 1024);
while ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] != '/')) {
i -= 1;
}
if ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] == '/')) {
OPM_InstallDir[__X(i - 1, 1024)] = 0x00;
if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
return;
}
}
__COPY("", OPM_InstallDir, 1024);
}
static void EnumPtrs(void (*P)(void*))
{
__ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P);
@ -1071,6 +1158,7 @@ export void *OPM__init(void)
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Files);
__MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
@ -1079,7 +1167,6 @@ export void *OPM__init(void)
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
__REGCMD("DeleteNewSym", OPM_DeleteNewSym);
__REGCMD("InitOptions", OPM_InitOptions);
__REGCMD("LogWLn", OPM_LogWLn);
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
@ -1089,5 +1176,8 @@ export void *OPM__init(void)
OPM_MaxLReal = 1.79769296342094e+308;
OPM_MinReal = -OPM_MaxReal;
OPM_MinLReal = -OPM_MaxLReal;
OPM_FindInstallDir();
OPM_hasComment = 0;
OPM_currentComment[0] = 0x00;
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPM__h
@ -9,7 +9,7 @@
import CHAR OPM_Model[10];
import INT16 OPM_AddressSize, OPM_Alignment;
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 LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
@ -17,34 +17,39 @@ import INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
import INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
import CHAR OPM_modName[32];
import CHAR OPM_objname[64];
import CHAR OPM_InstallDir[1024];
import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
import void OPM_DeleteNewSym (void);
import void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
import void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
import void OPM_FPrint (INT32 *fp, INT64 val);
import void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
import void OPM_FPrintReal (INT32 *fp, REAL val);
import void OPM_FPrintSet (INT32 *fp, UINT64 val);
import void OPM_Get (CHAR *ch);
import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
import void OPM_GetComment (CHAR *text, ADDRESS text__len);
import void OPM_Init (BOOLEAN *done);
import void OPM_InitOptions (void);
import INT16 OPM_Integer (INT64 n);
import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
import void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
import void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
import void OPM_LogWNum (INT64 i, INT64 len);
import void OPM_LogWStr (CHAR *s, LONGINT s__len);
import void OPM_LogWStr (CHAR *s, ADDRESS s__len);
import INT32 OPM_Longint (INT64 n);
import void OPM_Mark (INT16 n, INT32 pos);
import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
import void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
import void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void);
import INT64 OPM_SignedMaximum (INT32 bytecount);
import INT64 OPM_SignedMinimum (INT32 bytecount);
import void OPM_StoreComment (CHAR *text, ADDRESS text__len);
import void OPM_SymRCh (CHAR *ch);
import INT32 OPM_SymRInt (void);
import INT64 OPM_SymRInt64 (void);
@ -61,8 +66,8 @@ import void OPM_WriteHex (INT64 i);
import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
import void OPM_WriteString (CHAR *s, LONGINT s__len);
import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
import void OPM_WriteString (CHAR *s, ADDRESS s__len);
import void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
import BOOLEAN OPM_eofSF (void);
import void OPM_err (INT16 n);
import void *OPM__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -527,7 +527,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
__COPY(OPS_name, name, 256);
__MOVE(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
if ((*x)->typ->form == 11) {
@ -634,7 +634,7 @@ static void OPP_StandProcCall (OPT_Node *x)
OPT_Node y = NIL;
INT8 m;
INT16 n;
m = (INT8)((INT16)(*x)->obj->adr);
m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128);
n = 0;
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@ -867,7 +867,7 @@ static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct
} else {
*mode = 1;
}
__COPY(OPS_name, name, 256);
__MOVE(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@ -943,7 +943,7 @@ static void GetCode__19 (void)
(*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
n += 1;
}
(*ext)[0] = (CHAR)n;
(*ext)[0] = __CHR(n);
OPS_Get(&OPP_sym);
} else {
for (;;) {
@ -956,14 +956,14 @@ static void GetCode__19 (void)
n = 1;
}
OPS_Get(&OPP_sym);
(*ext)[__X(n, 256)] = (CHAR)c;
(*ext)[__X(n, 256)] = __CHR(c);
}
if (OPP_sym == 19) {
OPS_Get(&OPP_sym);
} else if (OPP_sym == 35) {
OPP_err(19);
} else {
(*ext)[0] = (CHAR)n;
(*ext)[0] = __CHR(n);
break;
}
}
@ -1030,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
__COPY(OPS_name, *ProcedureDeclaration__16_s->name, 256);
__MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
OPP_CheckMark(&*ProcedureDeclaration__16_s->vis);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc);
@ -1129,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
__COPY(OPS_name, name, 256);
__MOVE(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@ -1665,6 +1665,9 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
obj->typ = OPT_undftyp;
OPP_CheckMark(&obj->vis);
if (OPP_sym == 9) {
if (((((((((__STRCMP(obj->name, "SHORTINT") == 0 || __STRCMP(obj->name, "INTEGER") == 0) || __STRCMP(obj->name, "LONGINT") == 0) || __STRCMP(obj->name, "HUGEINT") == 0) || __STRCMP(obj->name, "REAL") == 0) || __STRCMP(obj->name, "LONGREAL") == 0) || __STRCMP(obj->name, "SET") == 0) || __STRCMP(obj->name, "CHAR") == 0) || __STRCMP(obj->name, "TRUE") == 0) || __STRCMP(obj->name, "FALSE") == 0) {
OPM_Mark(-310, OPM_curpos);
}
OPS_Get(&OPP_sym);
OPP_TypeDecl(&obj->typ, &obj->typ);
} else if (OPP_sym == 34 || OPP_sym == 20) {
@ -1790,30 +1793,10 @@ void OPP_Module (OPT_Node *prog, UINT32 opt)
if (OPP_sym == 63) {
OPS_Get(&OPP_sym);
} else {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" sym: ", 15);
OPM_LogWNum(OPP_sym, 1);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.name: ", 15);
OPM_LogWStr(OPS_name, 256);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.str: ", 15);
OPM_LogWStr(OPS_str, 256);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
OPM_LogWNum(OPS_numtyp, 1);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
OPM_LogWNum(OPS_intval, 1);
OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
OPM_LogWStr((CHAR*)"compiling ", 11);
OPM_LogWStr(OPS_name, 256);
OPM_LogW('.');
OPM_LogCompiling(OPS_name, 256);
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
OPP_CheckSym(39);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPP__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym)
OPS_err(241);
break;
}
OPS_str[i] = OPS_ch;
OPS_str[__X(i, 256)] = OPS_ch;
i += 1;
}
OPM_Get(&OPS_ch);
OPS_str[i] = 0x00;
OPS_str[__X(i, 256)] = 0x00;
OPS_intval = i + 1;
if (OPS_intval == 2) {
*sym = 35;
@ -76,7 +76,7 @@ static void OPS_Identifier (INT8 *sym)
INT16 i;
i = 0;
do {
OPS_name[i] = OPS_ch;
OPS_name[__X(i, 256)] = OPS_ch;
i += 1;
OPM_Get(&OPS_ch);
} 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);
i -= 1;
}
OPS_name[i] = 0x00;
OPS_name[__X(i, 256)] = 0x00;
*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 (m > 0 || OPS_ch != '0') {
if (n < 24) {
dig[n] = OPS_ch;
dig[__X(n, 24)] = OPS_ch;
n += 1;
}
m += 1;
@ -173,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1;
if (n <= 2) {
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;
}
} else {
@ -187,7 +187,7 @@ static void OPS_Number (void)
OPS_intval = -1;
}
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;
}
} else {
@ -196,9 +196,9 @@ static void OPS_Number (void)
} else {
OPS_numtyp = 2;
while (i < n) {
d = Ord__7(dig[i], 0);
d = Ord__7(dig[__X(i, 24)], 0);
i += 1;
if (OPS_intval <= __DIV(9223372036854775807 - (INT64)d, 10)) {
if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
@ -214,7 +214,7 @@ static void OPS_Number (void)
expCh = 'E';
while (n > 0) {
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') {
expCh = OPS_ch;
@ -279,32 +279,74 @@ static void Comment__2 (void);
static void Comment__2 (void)
{
OPM_Get(&OPS_ch);
for (;;) {
for (;;) {
while (OPS_ch == '(') {
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);
if (OPS_ch == '*') {
Comment__2();
}
}
if (OPS_ch == '*') {
isExported = 1;
OPM_Get(&OPS_ch);
break;
}
if (OPS_ch == 0x00) {
break;
}
OPM_Get(&OPS_ch);
}
if (OPS_ch == ')') {
commentText[0] = 0x00;
OPM_StoreComment(commentText, 256);
OPM_Get(&OPS_ch);
break;
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);
} else {
prevCh = 0x00;
}
} else {
if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
}
}
prevCh = OPS_ch;
}
if (nestLevel > 0) {
OPM_Get(&OPS_ch);
}
}
if (OPS_ch == 0x00) {
OPS_err(5);
break;
}
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 (isExported) {
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 1.95 [2016/11/24]. 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
#define OPS__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -49,6 +49,15 @@ typedef
INT8 glbmno[64];
} OPT_ImpCtxt;
typedef
struct OPT_LinkDesc *OPT_Link;
typedef
struct OPT_LinkDesc {
OPS_Name name;
OPT_Link next;
} OPT_LinkDesc;
typedef
struct OPT_NodeDesc *OPT_Node;
@ -74,6 +83,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -101,6 +111,7 @@ static OPT_ExpCtxt OPT_expCtxt;
static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
static INT32 OPT_recno;
export OPT_Link OPT_Links;
export ADDRESS *OPT_ConstDesc__typ;
export ADDRESS *OPT_ObjDesc__typ;
@ -108,6 +119,7 @@ export ADDRESS *OPT_StrDesc__typ;
export ADDRESS *OPT_NodeDesc__typ;
export ADDRESS *OPT_ImpCtxt__typ;
export ADDRESS *OPT_ExpCtxt__typ;
export ADDRESS *OPT_LinkDesc__typ;
export void OPT_Align (INT32 *adr, INT32 base);
export INT32 OPT_BaseAlignment (OPT_Struct typ);
@ -120,7 +132,7 @@ static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res);
export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len);
export void OPT_FPrintObj (OPT_Object obj);
static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
@ -131,8 +143,9 @@ export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
static void OPT_InLinks (void);
static void OPT_InMod (INT8 *mno);
static void OPT_InName (CHAR *name, LONGINT name__len);
static void OPT_InName (CHAR *name, ADDRESS name__len);
static OPT_Object OPT_InObj (INT8 mno);
static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par);
static void OPT_InStruct (OPT_Struct *typ);
@ -154,12 +167,14 @@ export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
static void OPT_OutLinks (void);
static void OPT_OutMod (INT16 mno);
static void OPT_OutName (CHAR *name, LONGINT name__len);
static void OPT_OutName (CHAR *name, ADDRESS name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
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_ShorterOrLongerType (OPT_Struct x, INT16 dir);
export INT32 OPT_SizeAlignment (INT32 size);
@ -339,7 +354,7 @@ void OPT_TypSize (OPT_Struct typ)
}
typ->size = offset;
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) {
OPT_TypSize(typ->BaseTyp);
typ->size = typ->n * typ->BaseTyp->size;
@ -375,6 +390,10 @@ OPT_Object OPT_NewObj (void)
{
OPT_Object obj = NIL;
__NEW(obj, OPT_ObjDesc);
obj->typ = NIL;
obj->conval = NIL;
obj->comment = NIL;
obj->name[0] = 0x00;
return obj;
}
@ -434,14 +453,16 @@ void OPT_Init (OPS_Name name, UINT32 opt)
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
__COPY(name, OPT_SelfName, 256);
__COPY(name, OPT_topScope->name, 256);
__MOVE(name, OPT_SelfName, 256);
__MOVE(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
OPT_newsf = __IN(4, opt, 32);
OPT_findpc = __IN(8, opt, 32);
OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
__NEW(OPT_Links, OPT_LinkDesc);
__MOVE(name, OPT_Links->name, 256);
}
void OPT_Close (void)
@ -539,6 +560,8 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
OPT_Object ob0 = NIL, ob1 = NIL;
BOOLEAN left;
INT8 mnolev;
CHAR commentText[256];
INT16 j;
ob0 = OPT_topScope;
ob1 = ob0->right;
left = 0;
@ -570,13 +593,23 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
__COPY(name, ob1->name, 256);
mnolev = OPT_topScope->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;
}
}
*obj = ob1;
}
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -957,7 +990,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
}
}
static void OPT_InName (CHAR *name, LONGINT name__len)
static void OPT_InName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -1011,6 +1044,26 @@ static void OPT_InMod (INT8 *mno)
}
}
static void OPT_InLinks (void)
{
OPS_Name linkname;
OPT_Link l = NIL;
OPT_InName((void*)linkname, 256);
while (linkname[0] != 0x00) {
l = OPT_Links;
while ((l != NIL && __STRCMP(l->name, linkname) != 0)) {
l = l->next;
}
if (l == NIL) {
l = OPT_Links;
__NEW(OPT_Links, OPT_LinkDesc);
OPT_Links->next = l;
__MOVE(linkname, OPT_Links->name, 256);
}
OPT_InName((void*)linkname, 256);
}
}
static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
@ -1068,6 +1121,13 @@ static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
tag = OPM_SymRInt();
last = NIL;
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->mnolev = -mno;
if (last == NIL) {
@ -1186,7 +1246,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
*typ = OPT_NewStr(0, 1);
} else {
__COPY(name, obj->name, 256);
__MOVE(name, obj->name, 256);
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
@ -1216,7 +1276,7 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0;
tag = OPM_SymRInt();
if (tag == 35) {
(*typ)->sysflag = (INT16)OPM_SymRInt();
(*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768);
tag = OPM_SymRInt();
}
switch (tag) {
@ -1346,7 +1406,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPT_Struct typ = NIL;
INT32 tag;
OPT_ConstExt ext = NIL;
OPS_Name commentText;
BOOLEAN hasComment;
INT16 j;
INT32 len;
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) {
OPT_InStruct(&typ);
obj = typ->strobj;
@ -1362,7 +1452,7 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval);
obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) {
} else if ((tag >= 31 && tag <= 33)) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link);
@ -1377,8 +1467,8 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->mode = 9;
ext = OPT_NewExt();
obj->conval->ext = ext;
s = (INT16)OPM_SymRInt();
(*ext)[0] = (CHAR)s;
s = __SHORTF(OPM_SymRInt(), 32768);
(*ext)[0] = __CHR(s);
i = 1;
while (i <= s) {
OPM_SymRCh(&(*ext)[__X(i, 256)]);
@ -1389,20 +1479,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return NIL;
break;
}
} else if (tag == 20) {
obj->mode = 5;
OPT_InStruct(&obj->typ);
} else {
} else if (tag == 21 || tag == 22) {
obj->mode = 1;
if (tag == 22) {
obj->vis = 2;
}
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);
}
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);
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
@ -1458,9 +1565,15 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
OPM_DeleteSym((void*)name, 256);
*done = 0;
} else {
OPM_OldSym((void*)name, 256, &*done);
}
if (*done) {
OPT_InMod(&mno);
OPT_InLinks();
OPT_impCtxt.nextTag = OPM_SymRInt();
while (!OPM_eofSF()) {
obj = OPT_InObj(mno);
@ -1483,7 +1596,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
}
static void OPT_OutName (CHAR *name, LONGINT name__len)
static void OPT_OutName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -1507,6 +1620,17 @@ static void OPT_OutMod (INT16 mno)
}
}
static void OPT_OutLinks (void)
{
OPT_Link l = NIL;
l = OPT_Links;
while (l != NIL) {
OPT_OutName((void*)l->name, 256);
l = l->next;
}
OPM_SymWCh(0x00);
}
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
INT32 i, j, n;
@ -1700,7 +1824,7 @@ static void OPT_OutConstant (OPT_Object obj)
OPM_SymWInt(f);
switch (f) {
case 2: case 3:
OPM_SymWCh((CHAR)obj->conval->intval);
OPM_SymWCh(__CHR(obj->conval->intval));
break;
case 4:
OPM_SymWInt(obj->conval->intval);
@ -1728,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)
{
INT16 i, j;
OPT_ConstExt ext = NIL;
INT16 k, l;
if (obj != NIL) {
OPT_OutObj(obj->left);
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) {
OPT_FPrintErr(obj, 250);
} else if (obj->vis != 0) {
@ -1833,6 +1984,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
if (OPM_noerr) {
OPM_SymWInt(16);
OPT_OutName((void*)OPT_SelfName, 256);
OPT_OutLinks();
OPT_expCtxt.reffp = 0;
OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
@ -1854,7 +2006,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_newsf = 0;
OPT_symNew = 0;
if (!OPM_noerr || OPT_findpc) {
OPM_DeleteNewSym();
OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@ -1969,10 +2121,11 @@ static void EnumPtrs(void (*P)(void*))
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
P(OPT_Links);
}
__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_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,
@ -2008,6 +2161,7 @@ __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32,
1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996,
2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, -2044}};
__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-4}};
__TDESC(OPT_LinkDesc, 1, 1) = {__TDFLDS("LinkDesc", 260), {256, -8}};
export void *OPT__init(void)
{
@ -2024,6 +2178,7 @@ export void *OPT__init(void)
__INITYP(OPT_NodeDesc, OPT_NodeDesc, 0);
__INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0);
__INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0);
__INITYP(OPT_LinkDesc, OPT_LinkDesc, 0);
/* BEGIN */
OPT_topScope = NIL;
OPT_OpenScope(0, NIL);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPT__h
@ -21,6 +21,15 @@ typedef
LONGREAL realval;
} OPT_ConstDesc;
typedef
struct OPT_LinkDesc *OPT_Link;
typedef
struct OPT_LinkDesc {
OPS_Name name;
OPT_Link next;
} OPT_LinkDesc;
typedef
struct OPT_NodeDesc *OPT_Node;
@ -52,6 +61,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -75,11 +85,13 @@ import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
import OPT_Link OPT_Links;
import ADDRESS *OPT_ConstDesc__typ;
import ADDRESS *OPT_ObjDesc__typ;
import ADDRESS *OPT_StrDesc__typ;
import ADDRESS *OPT_NodeDesc__typ;
import ADDRESS *OPT_LinkDesc__typ;
import void OPT_Align (INT32 *adr, INT32 base);
import INT32 OPT_BaseAlignment (OPT_Struct typ);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -112,7 +112,7 @@ static void OPV_Stamp (OPS_Name s)
i += 2;
k = 0;
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);
k += 1;
} while (!(j == 0));
@ -163,7 +163,7 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
}
scope = obj->scope;
scope->leaf = 1;
__COPY(obj->name, scope->name, 256);
__MOVE(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@ -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)
{
INT64 d;
OPT_Struct array = NIL;
while ((n->class == 4 && n->typ->comp == 3)) {
dim += 1;
n = n->left;
}
if ((n->class == 3 && n->typ->comp == 3)) {
d = dim;
array = n->typ;
while (d > 0) {
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 {
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_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 (from == 7) {
OPV_SizeCast(n, newtype->size);
OPV_Entier(n, 9);
} else {
OPM_WriteString((CHAR*)"__SETOF(", 9);
OPV_Entier(n, -1);
@ -391,7 +403,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec)
}
} else if (to == 4) {
OPV_SizeCast(n, newtype->size);
OPV_Entier(n, 9);
} else if (to == 3) {
if (__IN(2, OPM_Options, 32)) {
OPM_WriteString((CHAR*)"__CHR", 6);
@ -1183,7 +1194,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
base = base->BaseTyp;
}
if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) {
OPC_Ident(base->strobj);
OPC_Andent(base);
OPM_WriteString((CHAR*)"__typ", 6);
} else if (base->form == 11) {
OPM_WriteString((CHAR*)"POINTER__typ", 13);
@ -1286,7 +1297,17 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
} else if (r->typ->comp == 3) {
OPM_WriteString((CHAR*)"__X(", 5);
OPC_Len(r->obj, r->typ, 0);
OPM_WriteString((CHAR*)" * ", 4);
OPM_WriteInt(r->typ->BaseTyp->size);
OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(l->typ->size + 1);
OPM_Write(')');
} else {
__ASSERT(r->typ->comp == 2, 0);
__ASSERT(r->typ->size <= l->typ->size, 0);
OPM_WriteInt(r->typ->size);
}
OPM_Write(')');

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPV__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -6,6 +6,7 @@
#define SET UINT32
#include "SYSTEM.h"
#include "Heap.h"
#include "Platform.h"
@ -16,17 +17,18 @@ static INT16 Out_in;
export void Out_Char (CHAR ch);
export void Out_Flush (void);
export void Out_Hex (INT64 x, INT64 n);
export void Out_Int (INT64 x, INT64 n);
static INT32 Out_Length (CHAR *s, LONGINT s__len);
static INT32 Out_Length (CHAR *s, ADDRESS s__len);
export void Out_Ln (void);
export void Out_LongReal (LONGREAL x, INT16 n);
export void Out_Open (void);
export void Out_Real (REAL x, INT16 n);
static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_);
export void Out_String (CHAR *str, LONGINT str__len);
export void Out_String (CHAR *str, ADDRESS str__len);
export LONGREAL Out_Ten (INT16 e);
static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i);
static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i);
#define Out_Entier64(x) (INT64)(x)
@ -55,7 +57,7 @@ void Out_Char (CHAR ch)
}
}
static INT32 Out_Length (CHAR *s, LONGINT s__len)
static INT32 Out_Length (CHAR *s, ADDRESS s__len)
{
INT32 l;
l = 0;
@ -65,7 +67,7 @@ static INT32 Out_Length (CHAR *s, LONGINT s__len)
return l;
}
void Out_String (CHAR *str, LONGINT str__len)
void Out_String (CHAR *str, ADDRESS str__len)
{
INT32 l;
INT16 error;
@ -78,7 +80,7 @@ void Out_String (CHAR *str, LONGINT str__len)
error = Platform_Write(1, (ADDRESS)str, l);
} else {
__MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l);
Out_in += (INT16)l;
Out_in += __SHORT(l, 32768);
}
__DEL(str);
}
@ -89,18 +91,18 @@ void Out_Int (INT64 x, INT64 n)
INT16 i;
BOOLEAN negative;
negative = x < 0;
if (x == (-9223372036854775807-1)) {
if (x == (-9223372036854775807LL-1)) {
__MOVE("8085774586302733229", s, 20);
i = 19;
} else {
if (x < 0) {
x = -x;
}
s[0] = (CHAR)(48 + __MOD(x, 10));
s[0] = __CHR(48 + __MOD(x, 10));
x = __DIV(x, 10);
i = 1;
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);
i += 1;
}
@ -119,19 +121,43 @@ void Out_Int (INT64 x, INT64 n)
}
}
void Out_Hex (INT64 x, INT64 n)
{
if (n < 1) {
n = 1;
} else if (n > 16) {
n = 16;
}
if (x >= 0) {
while ((n < 16 && __LSH(x, -__ASHL(n, 2), 64) != 0)) {
n += 1;
}
}
x = __ROT(x, __ASHL(16 - n, 2), 64);
while (n > 0) {
x = __ROTL(x, 4, 64);
n -= 1;
if (__MASK(x, -16) < 10) {
Out_Char(__CHR(__MASK(x, -16) + 48));
} else {
Out_Char(__CHR((__MASK(x, -16) - 10) + 65));
}
}
}
void Out_Ln (void)
{
Out_String(Platform_NL, 3);
Out_Flush();
}
static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i)
{
*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, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i)
{
INT16 j;
INT32 l;
@ -140,7 +166,7 @@ static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16
if (l > *i) {
l = *i;
}
*i -= (INT16)l;
*i -= __SHORT(l, 32768);
j = 0;
while (j < l) {
s[__X(*i + j, s__len)] = t[__X(j, t__len)];
@ -175,7 +201,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
INT64 m;
INT16 d, dr;
e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
f = __MASK((__VAL(INT64, x)), -4503599627370496);
f = __MASK((__VAL(INT64, x)), -4503599627370496LL);
nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
if (nn) {
n -= 1;
@ -222,7 +248,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
if (nn) {
x = -x;
}
e = (INT16)__ASHR((e - 1023) * 77, 8);
e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
if (e >= 0) {
x = x / (LONGREAL)Out_Ten(e);
} else {
@ -306,6 +332,7 @@ void Out_LongReal (LONGREAL x, INT16 n)
export void *Out__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Out", 0);
__REGCMD("Flush", Out_Flush);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Out__h
@ -11,12 +11,13 @@ import BOOLEAN Out_IsConsole;
import void Out_Char (CHAR ch);
import void Out_Flush (void);
import void Out_Hex (INT64 x, INT64 n);
import void Out_Int (INT64 x, INT64 n);
import void Out_Ln (void);
import void Out_LongReal (LONGREAL x, INT16 n);
import void Out_Open (void);
import void Out_Real (REAL x, INT16 n);
import void Out_String (CHAR *str, LONGINT str__len);
import void Out_String (CHAR *str, ADDRESS str__len);
import LONGREAL Out_Ten (INT16 e);
import void *Out__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -7,37 +7,18 @@
#include "SYSTEM.h"
typedef
CHAR (*Platform_ArgPtr)[1024];
typedef
Platform_ArgPtr (*Platform_ArgVec)[1024];
typedef
INT32 (*Platform_ArgVecPtr)[1];
typedef
CHAR (*Platform_EnvPtr)[1024];
typedef
struct Platform_FileIdentity {
INT32 volume, index, mtime;
} Platform_FileIdentity;
typedef
void (*Platform_HaltProcedure)(INT32);
typedef
void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
export INT32 Platform_MainStackFrame;
export INT16 Platform_PID;
export CHAR Platform_CWD[256];
export INT16 Platform_ArgCount;
export INT32 Platform_ArgVector;
static Platform_HaltProcedure Platform_HaltHandler;
static INT32 Platform_TimeStart;
export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
export CHAR Platform_NL[3];
@ -45,35 +26,33 @@ export CHAR Platform_NL[3];
export ADDRESS *Platform_FileIdentity__typ;
export BOOLEAN Platform_Absent (INT16 e);
export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
export INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
export INT16 Platform_Close (INT32 h);
export BOOLEAN Platform_ConnectionFailed (INT16 e);
export void Platform_Delay (INT32 ms);
export BOOLEAN Platform_DifferentFilesystems (INT16 e);
export INT16 Platform_Error (void);
export void Platform_Exit (INT32 code);
export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
export void Platform_GetClock (INT32 *t, INT32 *d);
export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
export void Platform_GetIntArg (INT16 n, INT32 *val);
export void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
export void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
export INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export BOOLEAN Platform_Inaccessible (INT16 e);
export void Platform_Init (INT32 argc, INT32 argvadr);
export BOOLEAN Platform_Interrupted (INT16 e);
export BOOLEAN Platform_IsConsole (INT32 h);
export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
export INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h);
export INT16 Platform_MaxNameLength (void);
export INT16 Platform_MaxPathLength (void);
export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
export BOOLEAN Platform_NoSuchDirectory (INT16 e);
export INT32 Platform_OSAllocate (INT32 size);
export void Platform_OSFree (INT32 address);
export INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
export INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
export INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
export INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
export INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
export INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
export INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
export INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
@ -83,16 +62,16 @@ export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__t
export void Platform_SetQuitHandler (Platform_SignalHandler handler);
export INT16 Platform_Size (INT32 h, INT32 *l);
export INT16 Platform_Sync (INT32 h);
export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
export INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
static void Platform_TestLittleEndian (void);
export INT32 Platform_Time (void);
export BOOLEAN Platform_TimedOut (INT16 e);
export BOOLEAN Platform_TooManyFiles (INT16 e);
export INT16 Platform_Truncate (INT32 h, INT32 l);
export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
export INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
export INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
static void Platform_YMDHMStoClock (INT32 ye, INT32 mo, INT32 da, INT32 ho, INT32 mi, INT32 se, INT32 *t, INT32 *d);
export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
#include <errno.h>
#include <errno.h>
@ -102,6 +81,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#include <sys/types.h>
#include <time.h>
#include <unistd.h>
#include <limits.h>
#include <stdio.h>
#include <stdlib.h>
#define Platform_EACCES() EACCES
@ -117,8 +97,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_EROFS() EROFS
#define Platform_ETIMEDOUT() ETIMEDOUT
#define Platform_EXDEV() EXDEV
extern void Heap_InitHeap();
#define Platform_HeapInitHeap() Heap_InitHeap()
#define Platform_NAMEMAX() NAME_MAX
#define Platform_PATHMAX() PATH_MAX
#define Platform_allocate(size) (ADDRESS)((void*)malloc((size_t)size))
#define Platform_chdir(n, n__len) chdir((char*)n)
#define Platform_closefile(fd) close(fd)
@ -129,7 +109,7 @@ extern void Heap_InitHeap();
#define Platform_fsync(fd) fsync(fd)
#define Platform_ftruncate(fd, l) ftruncate(fd, l)
#define Platform_getcwd(cwd, cwd__len) getcwd((char*)cwd, cwd__len)
#define Platform_getenv(var, var__len) (Platform_EnvPtr)getenv((char*)var)
#define Platform_getenv(var, var__len) getenv((char*)var)
#define Platform_getpid() (INTEGER)getpid()
#define Platform_gettimeval() struct timeval tv; gettimeofday(&tv,0)
#define Platform_isatty(fd) isatty(fd)
@ -203,6 +183,16 @@ BOOLEAN Platform_Interrupted (INT16 e)
return e == Platform_EINTR();
}
INT16 Platform_MaxNameLength (void)
{
return Platform_NAMEMAX();
}
INT16 Platform_MaxPathLength (void)
{
return Platform_PATHMAX();
}
INT32 Platform_OSAllocate (INT32 size)
{
return Platform_allocate(size);
@ -213,21 +203,14 @@ void Platform_OSFree (INT32 address)
Platform_free(address);
}
void Platform_Init (INT32 argc, INT32 argvadr)
{
Platform_ArgVecPtr av = NIL;
Platform_MainStackFrame = argvadr;
Platform_ArgCount = __VAL(INT16, argc);
av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
Platform_ArgVector = (*av)[0];
Platform_HeapInitHeap();
}
typedef
CHAR (*EnvPtr__83)[1024];
BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
Platform_EnvPtr p = NIL;
EnvPtr__83 p = NIL;
__DUP(var, var__len, CHAR);
p = Platform_getenv(var, var__len);
p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
if (p != NIL) {
__COPY(*p, val, val__len);
}
@ -235,7 +218,7 @@ BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__le
return p != NIL;
}
void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
@ -244,56 +227,6 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
{
Platform_ArgVec av = NIL;
if (n < Platform_ArgCount) {
av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
__COPY(*(*av)[__X(n, 1024)], val, val__len);
}
}
void Platform_GetIntArg (INT16 n, INT32 *val)
{
CHAR s[64];
INT32 k, d, i;
s[0] = 0x00;
Platform_GetArg(n, (void*)s, 64);
i = 0;
if (s[0] == '-') {
i = 1;
}
k = 0;
d = (INT16)s[__X(i, 64)] - 48;
while ((d >= 0 && d <= 9)) {
k = k * 10 + d;
i += 1;
d = (INT16)s[__X(i, 64)] - 48;
}
if (s[0] == '-') {
k = -k;
i -= 1;
}
if (i > 0) {
*val = k;
}
}
INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
{
INT16 i;
CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0;
Platform_GetArg(i, (void*)arg, 256);
while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1;
Platform_GetArg(i, (void*)arg, 256);
}
__DEL(s);
return i;
}
void Platform_SetInterruptHandler (Platform_SignalHandler handler)
{
Platform_sethandler(2, handler);
@ -345,7 +278,7 @@ void Platform_Delay (INT32 ms)
Platform_nanosleep(s, ns);
}
INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
{
__DUP(cmd, cmd__len, CHAR);
__DEL(cmd);
@ -357,7 +290,7 @@ INT16 Platform_Error (void)
return Platform_err();
}
INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openro(n, n__len);
@ -370,7 +303,7 @@ INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openrw(n, n__len);
@ -383,7 +316,7 @@ INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_opennew(n, n__len);
@ -423,7 +356,7 @@ INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *iden
return 0;
}
INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
__DUP(n, n__len, CHAR);
Platform_structstats();
@ -481,7 +414,7 @@ INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n)
__RETCHK;
}
INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n)
{
*n = Platform_readfile(h, (ADDRESS)b, b__len);
if (*n < 0) {
@ -535,7 +468,7 @@ INT16 Platform_Truncate (INT32 h, INT32 l)
__RETCHK;
}
INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
INT16 Platform_Unlink (CHAR *n, ADDRESS n__len)
{
if (Platform_unlink(n, n__len) < 0) {
return Platform_err();
@ -545,7 +478,7 @@ INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
__RETCHK;
}
INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
INT16 Platform_Chdir (CHAR *n, ADDRESS n__len)
{
INT16 r;
if ((Platform_chdir(n, n__len) >= 0 && Platform_getcwd((void*)Platform_CWD, 256) != NIL)) {
@ -556,7 +489,7 @@ INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
__RETCHK;
}
INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len)
{
if (Platform_rename(o, o__len, n, n__len) < 0) {
return Platform_err();
@ -587,7 +520,6 @@ export void *Platform__init(void)
__INITYP(Platform_FileIdentity, Platform_FileIdentity, 0);
/* BEGIN */
Platform_TestLittleEndian();
Platform_HaltHandler = NIL;
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
Platform_PID = Platform_getpid();

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Platform__h
@ -16,46 +16,41 @@ typedef
import BOOLEAN Platform_LittleEndian;
import INT32 Platform_MainStackFrame;
import INT16 Platform_PID;
import CHAR Platform_CWD[256];
import INT16 Platform_ArgCount;
import INT32 Platform_ArgVector;
import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
import CHAR Platform_NL[3];
import ADDRESS *Platform_FileIdentity__typ;
import BOOLEAN Platform_Absent (INT16 e);
import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
import INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
import INT16 Platform_Close (INT32 h);
import BOOLEAN Platform_ConnectionFailed (INT16 e);
import void Platform_Delay (INT32 ms);
import BOOLEAN Platform_DifferentFilesystems (INT16 e);
import INT16 Platform_Error (void);
import void Platform_Exit (INT32 code);
import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
import void Platform_GetClock (INT32 *t, INT32 *d);
import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
import void Platform_GetIntArg (INT16 n, INT32 *val);
import void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
import INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import BOOLEAN Platform_Inaccessible (INT16 e);
import void Platform_Init (INT32 argc, INT32 argvadr);
import BOOLEAN Platform_Interrupted (INT16 e);
import BOOLEAN Platform_IsConsole (INT32 h);
import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
import INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h);
import INT16 Platform_MaxNameLength (void);
import INT16 Platform_MaxPathLength (void);
import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
import BOOLEAN Platform_NoSuchDirectory (INT16 e);
import INT32 Platform_OSAllocate (INT32 size);
import void Platform_OSFree (INT32 address);
import INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
import INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
import INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
import INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
import INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
import INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
import INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
import INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
@ -65,14 +60,14 @@ import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__t
import void Platform_SetQuitHandler (Platform_SignalHandler handler);
import INT16 Platform_Size (INT32 h, INT32 *l);
import INT16 Platform_Sync (INT32 h);
import INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
import INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
import INT32 Platform_Time (void);
import BOOLEAN Platform_TimedOut (INT16 e);
import BOOLEAN Platform_TooManyFiles (INT16 e);
import INT16 Platform_Truncate (INT32 h, INT32 l);
import INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
import INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
import INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
import BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void *Platform__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -10,11 +10,11 @@
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
export void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
export void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len);
export void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
export void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
export void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
export INT16 Reals_Expo (REAL x);
export INT16 Reals_ExpoL (LONGREAL x);
export void Reals_SetExpo (REAL *x, INT16 ex);
@ -67,9 +67,9 @@ void Reals_SetExpo (REAL *x, INT16 ex)
{
CHAR c;
__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);
__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)
@ -79,7 +79,7 @@ INT16 Reals_ExpoL (LONGREAL x)
return __MASK(__ASHR(i, 4), -2048);
}
void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
INT32 i, j, k;
if (x < (LONGREAL)0) {
@ -87,27 +87,27 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
}
k = 0;
if (n > 9) {
i = (INT32)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000);
j = (INT32)__ENTIER(x - i * (LONGREAL)1000000000);
i = __SHORT(__ENTIER(x / (LONGREAL)(LONGREAL)1000000000), 2147483648LL);
j = __SHORT(__ENTIER(x - i * (LONGREAL)1000000000), 2147483648LL);
if (j < 0) {
j = 0;
}
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);
k += 1;
}
} else {
i = (INT32)__ENTIER(x);
i = __SHORT(__ENTIER(x), 2147483648LL);
}
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);
k += 1;
}
}
void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
@ -115,14 +115,14 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
static CHAR Reals_ToHex (INT16 i)
{
if (i < 10) {
return (CHAR)(i + 48);
return __CHR(i + 48);
} else {
return (CHAR)(i + 55);
return __CHR(i + 55);
}
__RETCHK;
}
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len)
{
INT16 i;
INT32 l;
@ -137,12 +137,12 @@ static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LO
}
}
void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Reals__h
@ -8,10 +8,10 @@
import void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
import void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
import void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
import void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
import void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
import INT16 Reals_Expo (REAL x);
import INT16 Reals_ExpoL (LONGREAL x);
import void Reals_SetExpo (REAL *x, INT16 ex);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -6,22 +6,25 @@
#define SET UINT32
#include "SYSTEM.h"
#include "Reals.h"
export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
export void Strings_Cap (CHAR *s, LONGINT s__len);
export void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
export void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
export void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
export INT16 Strings_Length (CHAR *s, LONGINT s__len);
export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
export INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
export void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
export void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
export void Strings_Cap (CHAR *s, ADDRESS s__len);
export void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
export void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
export void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
export INT16 Strings_Length (CHAR *s, ADDRESS s__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 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, LONGINT s__len)
INT16 Strings_Length (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
}
if (i <= 32767) {
__DEL(s);
return (INT16)i;
return __SHORT(i, 32768);
} else {
__DEL(s);
return 32767;
@ -39,7 +42,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
__RETCHK;
}
void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
@ -56,7 +59,7 @@ void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__
__DEL(extra);
}
void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
@ -87,7 +90,7 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, L
__DEL(source);
}
void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
{
INT16 len, i;
len = Strings_Length(s, s__len);
@ -110,7 +113,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
}
}
void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
__DUP(source, source__len, CHAR);
Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len));
@ -118,12 +121,12 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest,
__DEL(source);
}
void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len)
{
INT16 len, destLen, i;
__DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len);
destLen = (INT16)dest__len - 1;
destLen = __SHORT(dest__len, 32768) - 1;
if (pos < 0) {
pos = 0;
}
@ -143,7 +146,7 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHA
__DEL(source);
}
INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos)
{
INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
@ -175,7 +178,7 @@ INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len,
return -1;
}
void Strings_Cap (CHAR *s, LONGINT s__len)
void Strings_Cap (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@ -191,9 +194,9 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m);
static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m)
{
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
@ -220,7 +223,7 @@ static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__le
return 0;
}
BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len)
{
struct Match__7 _s;
BOOLEAN __retval;
@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT
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)
{
__DEFMOD;
__MODULE_IMPORT(Reals);
__REGMOD("Strings", 0);
/* BEGIN */
__ENDMOD;

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Strings__h
@ -8,15 +8,17 @@
import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
import void Strings_Cap (CHAR *s, LONGINT s__len);
import void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
import void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
import void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
import INT16 Strings_Length (CHAR *s, LONGINT s__len);
import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
import INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
import void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
import void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
import void Strings_Cap (CHAR *s, ADDRESS s__len);
import void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
import void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
import void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
import INT16 Strings_Length (CHAR *s, ADDRESS s__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 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);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -187,20 +187,20 @@ export void Texts_Append (Texts_Text T, Texts_Buffer B);
export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
export INT32 Texts_ElemPos (Texts_Elem E);
static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len);
static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_OpenBuf (Texts_Buffer B);
export void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
export void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@ -229,10 +229,10 @@ export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len)
{
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
@ -390,27 +390,27 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__t
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
Texts_CopyMsg *msg__ = (void*)msg;
__NEW(e, Texts__1);
Texts_CopyElem((void*)((Texts_Alien)E), (void*)e);
e->file = ((Texts_Alien)E)->file;
e->org = ((Texts_Alien)E)->org;
e->span = ((Texts_Alien)E)->span;
__COPY(((Texts_Alien)E)->mod, e->mod, 32);
__COPY(((Texts_Alien)E)->proc, e->proc, 32);
Texts_CopyElem((void*)(*(Texts_Alien*)&E), (void*)e);
e->file = (*(Texts_Alien*)&E)->file;
e->org = (*(Texts_Alien*)&E)->org;
e->span = (*(Texts_Alien*)&E)->span;
__MOVE((*(Texts_Alien*)&E)->mod, e->mod, 32);
__MOVE((*(Texts_Alien*)&E)->proc, e->proc, 32);
(*msg__).e = (Texts_Elem)e;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
Texts_IdentifyMsg *msg__ = (void*)msg;
__COPY(((Texts_Alien)E)->mod, (*msg__).mod, 32);
__COPY(((Texts_Alien)E)->proc, (*msg__).proc, 32);
__COPY((*(Texts_Alien*)&E)->mod, (*msg__).mod, 32);
__COPY((*(Texts_Alien*)&E)->proc, (*msg__).proc, 32);
(*msg__).mod[31] = 0x01;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_FileMsg, 1)) {
if (__IS(msg__typ, Texts_FileMsg, 1)) {
Texts_FileMsg *msg__ = (void*)msg;
if ((*msg__).id == 1) {
Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org);
i = ((Texts_Alien)E)->span;
Files_Set(&r, Files_Rider__typ, (*(Texts_Alien*)&E)->file, (*(Texts_Alien*)&E)->org);
i = (*(Texts_Alien*)&E)->span;
while (i > 0) {
Files_Read(&r, Files_Rider__typ, (void*)&ch);
Files_Write(&(*msg__).r, Files_Rider__typ, ch);
@ -646,7 +646,7 @@ void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
u = u->next;
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
} else __WITHCHK;
}
(*R).run = u;
@ -673,7 +673,7 @@ void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
(*R).elem = __GUARDP(u, Texts_ElemDesc, 1);
if (__ISP(un, Texts_PieceDesc, 1)) {
if (__ISP(un, Texts_PieceDesc, 1)) {
Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org);
Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&un)->file, (*(Texts_Piece*)&un)->org);
} else __WITHCHK;
}
} else {
@ -812,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ)
if ('9' < ch) {
if (('A' <= ch && ch <= 'F')) {
hex = 1;
ch = (CHAR)((INT16)ch - 7);
ch = __CHR((INT16)ch - 7);
} else if (('a' <= ch && ch <= 'f')) {
hex = 1;
ch = (CHAR)((INT16)ch - 39);
ch = __CHR((INT16)ch - 39);
} else {
break;
}
@ -1027,7 +1027,7 @@ void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
Texts_Write(&*W, W__typ, 0x0d);
}
void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@ -1046,7 +1046,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
CHAR a[24];
i = 0;
if (x < 0) {
if (x == (-9223372036854775807-1)) {
if (x == (-9223372036854775807LL-1)) {
Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
@ -1057,7 +1057,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
x0 = x;
}
do {
a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48);
a[__X(i, 24)] = __CHR(__MOD(x0, 10) + 48);
x0 = __DIV(x0, 10);
i += 1;
} while (!(x0 == 0));
@ -1084,9 +1084,9 @@ void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x)
do {
y = __MASK(x, -16);
if (y < 10) {
a[__X(i, 20)] = (CHAR)(y + 48);
a[__X(i, 20)] = __CHR(y + 48);
} else {
a[__X(i, 20)] = (CHAR)(y + 55);
a[__X(i, 20)] = __CHR(y + 55);
}
x = __ASHR(x, 4);
i += 1;
@ -1162,8 +1162,8 @@ void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n)
} else {
Texts_Write(&*W, W__typ, '+');
}
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
}
}
@ -1313,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
} else {
Texts_Write(&*W, W__typ, ' ');
}
e = (INT16)__ASHR((e - 1023) * 77, 8);
e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
if (e >= 0) {
x = x / (LONGREAL)Reals_TenL(e);
} else {
@ -1344,10 +1344,10 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
} else {
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);
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
}
}
@ -1374,8 +1374,8 @@ 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, (CHAR)(__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(__DIV(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)
@ -1406,8 +1406,8 @@ static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span
static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
Modules_Module M = NIL;
Modules_Command Cmd;
Heap_Module M = NIL;
Heap_Command Cmd;
Texts_Alien a = NIL;
INT32 org, ew, eh;
INT8 eno;
@ -1539,7 +1539,7 @@ void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Texts_Load0(&*r, r__typ, T);
}
void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
@ -1715,9 +1715,9 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
while (u != T->head) {
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
if (((Texts_Piece)u)->ascii) {
Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
delta = ((Texts_Piece)u)->len;
if ((*(Texts_Piece*)&u)->ascii) {
Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
delta = (*(Texts_Piece*)&u)->len;
while (delta > 0) {
Files_Read(&r1, Files_Rider__typ, (void*)&ch);
delta -= 1;
@ -1728,8 +1728,8 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
}
}
} else {
Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
delta = ((Texts_Piece)u)->len;
Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
delta = (*(Texts_Piece*)&u)->len;
while (delta > 1024) {
Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
@ -1755,7 +1755,7 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Store__39_s = _s.lnk;
}
void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Texts__h
@ -130,7 +130,7 @@ import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
@ -138,7 +138,7 @@ import Texts_Text Texts_ElemBase (Texts_Elem E);
import INT32 Texts_ElemPos (Texts_Elem E);
import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_OpenBuf (Texts_Buffer B);
import void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
import void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@ -165,7 +165,7 @@ import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
import void *Texts__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -27,23 +27,24 @@ export void VT100_DECTCEMl (void);
export void VT100_DSR (INT16 n);
export void VT100_ED (INT16 n);
export void VT100_EL (INT16 n);
static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len);
static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len);
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len);
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len);
export void VT100_HVP (INT16 n, INT16 m);
export void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
export void VT100_RCP (void);
static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end);
export void VT100_Reset (void);
static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end);
export void VT100_SCP (void);
export void VT100_SD (INT16 n);
export void VT100_SGR (INT16 n);
export void VT100_SGR2 (INT16 n, INT16 m);
export void VT100_SU (INT16 n);
export void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
export void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end)
{
CHAR h;
while (start < end) {
@ -55,7 +56,7 @@ static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
}
}
void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
{
CHAR b[21];
INT16 s, e;
@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
}
e = s;
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);
e += 1;
} while (!(int_ == 0));
@ -84,7 +85,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
__COPY(b, str, str__len);
}
static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
{
CHAR cmd[9];
__DUP(letter, letter__len, CHAR);
@ -94,7 +95,7 @@ static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@ -107,7 +108,7 @@ static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@ -120,7 +121,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[5], mstr[5];
CHAR cmd[12];
@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
__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)
{
VT100_EscSeq(n, (CHAR*)"A", 2);
@ -236,7 +246,7 @@ void VT100_DECTCEMh (void)
VT100_EscSeq0((CHAR*)"\?25h", 5);
}
void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
void VT100_SetAttr (CHAR *attr, ADDRESS attr__len)
{
CHAR tmpstr[16];
__DUP(attr, attr__len, CHAR);
@ -256,6 +266,7 @@ export void *VT100__init(void)
__REGCMD("DECTCEMh", VT100_DECTCEMh);
__REGCMD("DECTCEMl", VT100_DECTCEMl);
__REGCMD("RCP", VT100_RCP);
__REGCMD("Reset", VT100_Reset);
__REGCMD("SCP", VT100_SCP);
/* BEGIN */
__COPY("\033", VT100_CSI, 5);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define VT100__h
@ -23,14 +23,15 @@ import void VT100_DSR (INT16 n);
import void VT100_ED (INT16 n);
import void VT100_EL (INT16 n);
import void VT100_HVP (INT16 n, INT16 m);
import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
import void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
import void VT100_RCP (void);
import void VT100_Reset (void);
import void VT100_SCP (void);
import void VT100_SD (INT16 n);
import void VT100_SGR (INT16 n);
import void VT100_SGR2 (INT16 n, INT16 m);
import void VT100_SU (INT16 n);
import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
import void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
import void *VT100__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -7,33 +7,40 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Heap.h"
#include "Modules.h"
#include "OPM.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
static CHAR extTools_CFLAGS[1023];
typedef
CHAR extTools_CommandString[4096];
export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
static extTools_CommandString extTools_CFLAGS;
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__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);
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;
extTools_CommandString fullcmd;
__DUP(title, title__len, CHAR);
__DUP(cmd, cmd__len, CHAR);
if (__IN(18, OPM_Options, 32)) {
Out_String(title, title__len);
Out_String((CHAR*)" ", 3);
Out_String(cmd, cmd__len);
Out_Ln();
}
r = Platform_System(cmd, cmd__len);
__COPY(cmd, fullcmd, 4096);
Heap_GC(0);
r = Platform_System(fullcmd, 4096);
status = __MASK(r, -128);
exitcode = __ASHR(r, 8);
if (exitcode > 127) {
@ -63,50 +70,55 @@ static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGIN
__DEL(cmd);
}
static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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(OPM_ResourceDir, 1024, (void*)s, s__len);
Strings_Append((CHAR*)"/include\" ", 11, (void*)s, s__len);
Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 1023);
Strings_Append(extTools_CFLAGS, 1023, (void*)s, s__len);
Strings_Append(additionalopts, additionalopts__len, (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, LONGINT moduleName__len)
void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len)
{
CHAR cmd[1023];
extTools_CommandString cmd;
__DUP(moduleName, moduleName__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 1023);
Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 1023);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023);
Strings_Append((CHAR*)".c", 3, (void*)cmd, 1023);
extTools_execute((CHAR*)"Assemble: ", 11, cmd, 1023);
extTools_InitialiseCompilerCommand((void*)cmd, 4096, (CHAR*)"", 1);
Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096);
extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096);
__DEL(moduleName);
}
void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT 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);
extTools_InitialiseCompilerCommand((void*)cmd, 1023);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023);
Strings_Append((CHAR*)".c ", 4, (void*)cmd, 1023);
Strings_Append(additionalopts, additionalopts__len, (void*)cmd, 1023);
extTools_InitialiseCompilerCommand((void*)cmd, 4096, additionalopts, additionalopts__len);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096);
if (statically) {
Strings_Append((CHAR*)"-static", 8, (void*)cmd, 1023);
Strings_Append((CHAR*)" -static", 9, (void*)cmd, 4096);
}
Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 1023);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023);
Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 1023);
Strings_Append((CHAR*)"", 1, (void*)cmd, 1023);
Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 1023);
Strings_Append((CHAR*)" -l voc", 8, (void*)cmd, 1023);
Strings_Append((CHAR*)"-O", 3, (void*)cmd, 1023);
Strings_Append(OPM_Model, 10, (void*)cmd, 1023);
Strings_Append((CHAR*)"", 1, (void*)cmd, 1023);
extTools_execute((CHAR*)"Assemble and link: ", 20, cmd, 1023);
Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
if (!statically || 1) {
Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 4096);
Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 4096);
Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 4096);
Strings_Append((CHAR*)" -lvoc", 7, (void*)cmd, 4096);
Strings_Append((CHAR*)"-O", 3, (void*)cmd, 4096);
Strings_Append(OPM_Model, 10, (void*)cmd, 4096);
Strings_Append((CHAR*)"", 1, (void*)cmd, 4096);
}
extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096);
__DEL(additionalopts);
}
@ -115,6 +127,7 @@ export void *extTools__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Modules);
__MODULE_IMPORT(OPM);
__MODULE_IMPORT(Out);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define extTools__h
@ -8,8 +8,8 @@
import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
import void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len);
import void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len);
import void *extTools__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -20,9 +20,9 @@
#include "extTools.h"
static CHAR Compiler_mname[256];
static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len);
export void Compiler_Module (BOOLEAN *done);
static void Compiler_PropagateElementaryTypeSizes (void);
export void Compiler_Translate (void);
@ -41,11 +41,12 @@ void Compiler_Module (BOOLEAN *done)
OPT_Export(&ext, &new);
if (OPM_noerr) {
OPM_OpenFiles((void*)OPT_SelfName, 256);
OPM_DeleteObj((void*)OPT_SelfName, 256);
OPC_Init();
OPV_Module(p);
if (OPM_noerr) {
if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
OPM_DeleteNewSym();
OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogWStr((CHAR*)" Main program.", 16);
OPM_LogVT100((CHAR*)"0m", 3);
@ -61,7 +62,7 @@ void Compiler_Module (BOOLEAN *done)
}
}
} else {
OPM_DeleteNewSym();
OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@ -88,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp;
switch (OPM_LongintSize) {
switch (OPM_SetSize) {
case 4:
OPT_settyp = OPT_set32typ;
break;
@ -104,14 +105,44 @@ static void Compiler_PropagateElementaryTypeSizes (void)
}
}
static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len)
{
OPT_Link l = NIL;
CHAR fn[64];
Platform_FileIdentity id;
objectnames[0] = 0x00;
l = OPT_Links;
while (l != NIL) {
__COPY(l->name, fn, 64);
Strings_Append((CHAR*)".sym", 5, (void*)fn, 64);
if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
__COPY(l->name, fn, 64);
Strings_Append((CHAR*)".o", 3, (void*)fn, 64);
if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
Strings_Append((CHAR*)" ", 2, (void*)objectnames, objectnames__len);
Strings_Append(fn, 64, (void*)objectnames, objectnames__len);
} else {
OPM_LogVT100((CHAR*)"91m", 4);
OPM_LogWStr((CHAR*)"Link warning: a local symbol file is present for module ", 57);
OPM_LogWStr(l->name, 256);
OPM_LogWStr((CHAR*)", but local object file '", 26);
OPM_LogWStr(fn, 64);
OPM_LogWStr((CHAR*)"' is missing.", 14);
OPM_LogVT100((CHAR*)"0m", 3);
OPM_LogWLn();
}
}
l = l->next;
}
}
void Compiler_Translate (void)
{
BOOLEAN done;
CHAR modulesobj[2048];
modulesobj[0] = 0x00;
CHAR linkfiles[2048];
if (OPM_OpenPar()) {
for (;;) {
OPM_Init(&done, (void*)Compiler_mname, 256);
OPM_Init(&done);
if (!done) {
return;
}
@ -131,11 +162,9 @@ void Compiler_Translate (void)
} else {
if (!__IN(10, OPM_Options, 32)) {
extTools_Assemble(OPM_modName, 32);
Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
} else {
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
}
}
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -8,7 +8,7 @@
#include "SYSTEM.h"
export CHAR Configuration_versionLong[75];
export CHAR Configuration_versionLong[76];
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
__MOVE("1.95 [2016/11/24]. 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;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Configuration__h
@ -6,7 +6,7 @@
#include "SYSTEM.h"
import CHAR Configuration_versionLong[75];
import CHAR Configuration_versionLong[76];
import void *Configuration__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -26,7 +26,7 @@ typedef
Files_BufDesc *Files_Buffer;
typedef
CHAR Files_FileName[101];
CHAR Files_FileName[256];
typedef
struct Files_FileDesc {
@ -36,7 +36,7 @@ typedef
INT32 fd, len, pos;
Files_Buffer bufs[4];
INT16 swapper, state;
Files_File next;
struct Files_FileDesc *next;
} Files_FileDesc;
typedef
@ -48,11 +48,12 @@ typedef
} Files_Rider;
static Files_File Files_files;
export INT16 Files_MaxPathLength, Files_MaxNameLength;
static Files_FileDesc *Files_files;
static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
LONGINT len[1];
ADDRESS len[1];
CHAR data[1];
} *Files_SearchPath;
@ -60,58 +61,68 @@ export ADDRESS *Files_FileDesc__typ;
export ADDRESS *Files_BufDesc__typ;
export ADDRESS *Files_Rider__typ;
static void Files_Assert (BOOLEAN truth);
export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
export void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
export void Files_Close (Files_File f);
static void Files_CloseOSFile (Files_File f);
static void Files_Create (Files_File f);
export void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode);
export void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
static void Files_Deregister (CHAR *name, ADDRESS name__len);
static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode);
static void Files_Finalize (SYSTEM_PTR o);
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len);
static void Files_Flush (Files_Buffer buf);
export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
export void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len);
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len);
export INT32 Files_Length (Files_File f);
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
export Files_File Files_New (CHAR *name, LONGINT name__len);
export Files_File Files_Old (CHAR *name, LONGINT name__len);
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len);
export Files_File Files_New (CHAR *name, ADDRESS name__len);
export Files_File Files_Old (CHAR *name, ADDRESS name__len);
export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
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_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
export void Files_Register (Files_File f);
export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len);
export void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len);
export void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
export void Files_SetSearchPath (CHAR *path, LONGINT path__len);
export void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
#define Files_IdxTrap() __HALT(-1)
#define Files_ToAdr(x) (ADDRESS)x
static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
static void Files_Assert (BOOLEAN truth)
{
if (!truth) {
Out_Ln();
__ASSERT(truth, 0);
}
}
static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
Out_Ln();
@ -120,17 +131,17 @@ static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
Out_String((CHAR*)": ", 3);
if (f != NIL) {
if (f->registerName[0] != 0x00) {
Out_String(f->registerName, 101);
Out_String(f->registerName, 256);
} else {
Out_String(f->workName, 101);
Out_String(f->workName, 256);
}
if (f->fd != 0) {
Out_String((CHAR*)"f.fd = ", 8);
Out_String((CHAR*)", f.fd = ", 10);
Out_Int(f->fd, 1);
}
}
if (errcode != 0) {
Out_String((CHAR*)" errcode = ", 12);
Out_String((CHAR*)", errcode = ", 13);
Out_Int(errcode, 1);
}
Out_Ln();
@ -138,98 +149,125 @@ static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
__DEL(s);
}
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT 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(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;
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;
while (dir[i] != 0x00) {
dest[i] = dir[i];
i += 1;
}
if (dest[i - 1] != '/') {
dest[i] = '/';
i += 1;
}
while (name[j] != 0x00) {
dest[i] = name[j];
while (j < ln) {
dest[__X(i, dest__len)] = name[__X(j, name__len)];
i += 1;
j += 1;
}
dest[i] = 0x00;
dest[__X(i, dest__len)] = 0x00;
__DEL(dir);
__DEL(name);
}
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT 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);
if (finalName[0] == '/') {
__COPY(finalName, name, name__len);
} else {
Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len);
}
i = Strings_Length(name, name__len) - 1;
while ((i > 0 && name[__X(i, name__len)] != '/')) {
i -= 1;
}
if ((i + 16) >= name__len) {
Files_Err((CHAR*)"File name too long", 19, NIL, 0);
}
Files_tempno += 1;
n = Files_tempno;
i = 0;
if (finalName[0] != '/') {
while (Platform_CWD[i] != 0x00) {
name[i] = Platform_CWD[i];
i += 1;
}
if (Platform_CWD[i - 1] != '/') {
name[i] = '/';
i += 1;
}
}
j = 0;
while (finalName[j] != 0x00) {
name[i] = finalName[j];
i += 1;
j += 1;
}
i -= 1;
while (name[i] != '/') {
i -= 1;
}
name[i + 1] = '.';
name[i + 2] = 't';
name[i + 3] = 'm';
name[i + 4] = 'p';
name[i + 5] = '.';
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;
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);
i += 1;
}
name[i] = '.';
name[__X(i, name__len)] = '.';
i += 1;
n = Platform_PID;
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);
i += 1;
}
name[i] = 0x00;
name[__X(i, name__len)] = 0x00;
__DEL(finalName);
}
static void Files_Deregister (CHAR *name, ADDRESS name__len)
{
Platform_FileIdentity identity;
Files_File osfile = NIL;
INT16 error;
__DUP(name, name__len, CHAR);
if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) {
osfile = (Files_File)Files_files;
while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) {
osfile = (Files_File)osfile->next;
}
if (osfile != NIL) {
__ASSERT(!osfile->tempFile, 0);
__ASSERT(osfile->fd >= 0, 0);
__MOVE(osfile->workName, osfile->registerName, 256);
Files_GetTempName(osfile->registerName, 256, (void*)osfile->workName, 256);
osfile->tempFile = 1;
osfile->state = 0;
error = Platform_Rename((void*)osfile->registerName, 256, (void*)osfile->workName, 256);
if (error != 0) {
Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error);
}
}
}
__DEL(name);
}
static void Files_Create (Files_File f)
{
Platform_FileIdentity identity;
BOOLEAN done;
INT16 error;
CHAR err[32];
if (f->fd == -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;
} else if (f->state == 2) {
__COPY(f->registerName, f->workName, 101);
} else {
__ASSERT(f->state == 2, 0);
Files_Deregister(f->registerName, 256);
__MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
error = Platform_Unlink((void*)f->workName, 101);
error = Platform_New((void*)f->workName, 101, &f->fd);
error = Platform_Unlink((void*)f->workName, 256);
error = Platform_New((void*)f->workName, 256, &f->fd);
done = error == 0;
if (done) {
f->next = Files_files;
@ -275,27 +313,6 @@ static void Files_Flush (Files_Buffer buf)
}
}
static void Files_CloseOSFile (Files_File f)
{
Files_File prev = NIL;
INT16 error;
if (Files_files == f) {
Files_files = f->next;
} else {
prev = Files_files;
while ((prev != NIL && prev->next != f)) {
prev = prev->next;
}
if (prev->next != NIL) {
prev->next = f->next;
}
}
error = Platform_Close(f->fd);
f->fd = -1;
f->state = 1;
Heap_FileCount -= 1;
}
void Files_Close (Files_File f)
{
INT32 i;
@ -303,11 +320,10 @@ void Files_Close (Files_File f)
if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f);
i = 0;
while ((i < 4 && f->bufs[i] != NIL)) {
Files_Flush(f->bufs[i]);
while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) {
Files_Flush(f->bufs[__X(i, 4)]);
i += 1;
}
Files_CloseOSFile(f);
}
}
@ -316,13 +332,13 @@ INT32 Files_Length (Files_File f)
return f->len;
}
Files_File Files_New (CHAR *name, LONGINT name__len)
Files_File Files_New (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc);
f->workName[0] = 0x00;
__COPY(name, f->registerName, 101);
__COPY(name, f->registerName, 256);
f->fd = -1;
f->state = 1;
f->len = 0;
@ -332,7 +348,7 @@ Files_File Files_New (CHAR *name, LONGINT name__len)
return f;
}
static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
{
INT16 i;
CHAR ch;
@ -344,38 +360,38 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
*pos += 1;
}
} else {
ch = (Files_SearchPath->data)[*pos];
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (ch == ' ' || ch == ';') {
*pos += 1;
ch = (Files_SearchPath->data)[*pos];
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
}
if (ch == '~') {
*pos += 1;
ch = (Files_SearchPath->data)[*pos];
while (Files_HOME[i] != 0x00) {
dir[i] = Files_HOME[i];
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (Files_HOME[__X(i, 1024)] != 0x00) {
dir[__X(i, dir__len)] = Files_HOME[__X(i, 1024)];
i += 1;
}
if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) {
while ((i > 0 && dir[i - 1] != '/')) {
while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) {
i -= 1;
}
}
}
while ((ch != 0x00 && ch != ';')) {
dir[i] = ch;
dir[__X(i, dir__len)] = ch;
i += 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;
}
}
dir[i] = 0x00;
dir[__X(i, dir__len)] = 0x00;
}
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -383,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
ch = name[0];
while ((ch != 0x00 && ch != '/')) {
i += 1;
ch = name[i];
ch = name[__X(i, name__len)];
}
return ch == '/';
}
@ -392,15 +408,15 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
Files_File f = NIL;
INT16 i, error;
f = Files_files;
f = (Files_File)Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
if (!Platform_SameFileTime(identity, f->identity)) {
i = 0;
while (i < 4) {
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
}
i += 1;
}
@ -410,12 +426,12 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
}
return f;
}
f = f->next;
f = (Files_File)f->next;
}
return NIL;
}
Files_File Files_Old (CHAR *name, LONGINT name__len)
Files_File Files_Old (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
INT32 fd;
@ -456,6 +472,7 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
error = Platform_Close(fd);
__DEL(name);
return f;
} else {
@ -466,7 +483,7 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
f->pos = 0;
f->swapper = -1;
error = Platform_Size(fd, &f->len);
__COPY(name, f->workName, 101);
__COPY(name, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
f->identity = identity;
@ -498,9 +515,9 @@ void Files_Purge (Files_File f)
INT16 error;
i = 0;
while (i < 4) {
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
}
i += 1;
}
@ -526,7 +543,7 @@ void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
__ASSERT((*r).offset <= 4096, 0);
Files_Assert((*r).offset <= 4096);
return (*r).org + (*r).offset;
}
@ -544,22 +561,22 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
offset = __MASK(pos, -4096);
org = pos - offset;
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;
}
if (i < 4) {
if (f->bufs[i] == NIL) {
if (f->bufs[__X(i, 4)] == NIL) {
__NEW(buf, Files_BufDesc);
buf->chg = 0;
buf->org = -1;
buf->f = f;
f->bufs[i] = buf;
f->bufs[__X(i, 4)] = buf;
} else {
buf = f->bufs[i];
buf = f->bufs[__X(i, 4)];
}
} else {
f->swapper = __MASK(f->swapper + 1, -4);
buf = f->bufs[f->swapper];
buf = f->bufs[__X(f->swapper, 4)];
Files_Flush(buf);
}
if (buf->org != org) {
@ -585,7 +602,7 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
org = 0;
offset = 0;
}
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@ -604,9 +621,9 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
__ASSERT(offset <= buf->size, 0);
Files_Assert(offset <= buf->size);
if (offset < buf->size) {
*x = buf->data[offset];
*x = buf->data[__X(offset, 4096)];
(*r).offset = offset + 1;
} else if ((*r).org + offset < buf->f->len) {
Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset);
@ -618,7 +635,12 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
}
}
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
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)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -644,12 +666,12 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
__MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
__MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
}
(*r).res = 0;
(*r).eof = 0;
@ -666,14 +688,14 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
__ASSERT(offset < 4096, 0);
buf->data[offset] = x;
Files_Assert(offset < 4096);
buf->data[__X(offset, 4096)] = x;
buf->chg = 1;
if (offset == buf->size) {
buf->size += 1;
@ -683,7 +705,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -694,23 +716,23 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
__MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
__MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
offset += min;
(*r).offset = offset;
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@ -722,14 +744,15 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
Files_Deregister(name, name__len);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res)
{
INT32 fdold, fdnew, n;
INT16 error, ignore;
@ -795,31 +818,30 @@ void Files_Register (Files_File f)
{
INT16 idx, errcode;
Files_File f1 = NIL;
CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
f->state = 2;
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
Files_Deregister(f->registerName, 256);
Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
if (errcode != 0) {
__COPY(f->registerName, file, 104);
__HALT(99);
Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
}
__COPY(f->registerName, f->workName, 101);
__MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
__DEL(path);
}
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len)
{
INT32 i, j;
if (!Platform_LittleEndian) {
@ -827,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *de
j = 0;
while (i > 0) {
i -= 1;
dest[j] = src[i];
dest[__X(j, dest__len)] = src[__X(i, src__len)];
j += 1;
}
} else {
@ -877,36 +899,36 @@ void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
CHAR ch;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&ch);
x[i] = ch;
x[__X(i, x__len)] = ch;
i += 1;
} while (!(ch == 0x00));
}
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&x[i]);
Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]);
i += 1;
} while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a));
if (x[i - 1] == 0x0a) {
} while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a));
if (x[__X(i - 1, x__len)] == 0x0a) {
i -= 1;
}
if ((i > 0 && x[i - 1] == 0x0d)) {
if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) {
i -= 1;
}
x[i] = 0x00;
x[__X(i, x__len)] = 0x00;
}
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len)
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
{
INT8 s, b;
INT64 q;
@ -919,7 +941,7 @@ void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__
Files_Read(&*R, R__typ, (void*)&b);
}
q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
__ASSERT(x__len <= 8, 0);
Files_Assert(x__len <= 8);
__MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
}
@ -931,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)
{
CHAR b[2];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[0] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2);
}
void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x)
{
CHAR b[4];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[2] = (CHAR)__ASHR(x, 16);
b[3] = (CHAR)__ASHR(x, 24);
b[0] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
b[2] = __CHR(__ASHR(x, 16));
b[3] = __CHR(__ASHR(x, 24));
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
@ -950,11 +972,13 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{
CHAR b[4];
INT32 i;
i = (INT32)x;
b[0] = (CHAR)i;
b[1] = (CHAR)__ASHR(i, 8);
b[2] = (CHAR)__ASHR(i, 16);
b[3] = (CHAR)__ASHR(i, 24);
UINT64 y;
y = x;
i = __VAL(INT32, y);
b[0] = __CHR(i);
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);
}
@ -972,11 +996,11 @@ void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
i = 0;
while (x[i] != 0x00) {
while (x[__X(i, x__len)] != 0x00) {
i += 1;
}
Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
@ -985,17 +1009,38 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len
void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{
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);
}
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, LONGINT name__len)
void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
{
__COPY(f->workName, name, name__len);
}
static void Files_CloseOSFile (Files_File f)
{
Files_File prev = NIL;
INT16 error;
if (Files_files == (void *) f) {
Files_files = f->next;
} else {
prev = (Files_File)Files_files;
while ((prev != NIL && prev->next != (void *) f)) {
prev = (Files_File)prev->next;
}
if (prev->next != NIL) {
prev->next = f->next;
}
}
error = Platform_Close(f->fd);
f->fd = -1;
f->state = 1;
Heap_FileCount -= 1;
}
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
@ -1004,12 +1049,12 @@ static void Files_Finalize (SYSTEM_PTR o)
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {
res = Platform_Unlink((void*)f->workName, 101);
res = Platform_Unlink((void*)f->workName, 256);
}
}
}
void Files_SetSearchPath (CHAR *path, LONGINT path__len)
void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
@ -1023,11 +1068,10 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
static void EnumPtrs(void (*P)(void*))
{
P(Files_files);
P(Files_SearchPath);
}
__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 252), {228, 232, 236, 240, 248, -24}};
__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_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}};
@ -1047,5 +1091,7 @@ export void *Files__init(void)
Heap_FileCount = 0;
Files_HOME[0] = 0x00;
Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024);
Files_MaxPathLength = Platform_MaxPathLength();
Files_MaxNameLength = Platform_MaxNameLength();
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Files__h
@ -10,9 +10,8 @@ typedef
typedef
struct Files_FileDesc {
char _prvt0[216];
INT32 fd;
char _prvt1[32];
INT32 _prvt0;
char _prvt1[560];
} Files_FileDesc;
typedef
@ -23,46 +22,48 @@ typedef
} Files_Rider;
import INT16 Files_MaxPathLength, Files_MaxNameLength;
import ADDRESS *Files_FileDesc__typ;
import ADDRESS *Files_Rider__typ;
import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
import void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
import void Files_Close (Files_File f);
import void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
import void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
import void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
import void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
import INT32 Files_Length (Files_File f);
import Files_File Files_New (CHAR *name, LONGINT name__len);
import Files_File Files_Old (CHAR *name, LONGINT name__len);
import Files_File Files_New (CHAR *name, ADDRESS name__len);
import Files_File Files_Old (CHAR *name, ADDRESS name__len);
import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
import void Files_Purge (Files_File f);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
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_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void Files_Register (Files_File f);
import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
import void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
import void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
import void Files_SetSearchPath (CHAR *path, LONGINT path__len);
import void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void *Files__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -68,8 +68,10 @@ static INT32 Heap_freeList[10];
static INT32 Heap_bigBlocks;
export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry;
static INT32 Heap_heap, Heap_heapend;
export INT32 Heap_heapsize;
static INT16 Heap_ldUnit;
export INT32 Heap_heap;
static INT32 Heap_heapMin, Heap_heapMax;
export INT32 Heap_heapsize, Heap_heapMinExpand;
static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
@ -84,15 +86,16 @@ static void Heap_CheckFin (void);
static void Heap_ExtendHeap (INT32 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
export INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
export void Heap_GC (BOOLEAN markStack);
static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len);
static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len);
export void Heap_INCREF (Heap_Module m);
export void Heap_InitHeap (void);
export void Heap_Lock (void);
static void Heap_Mark (INT32 q);
static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len);
static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len);
static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len);
export SYSTEM_PTR Heap_NEWBLK (INT32 size);
export SYSTEM_PTR Heap_NEWREC (INT32 tag);
static INT32 Heap_NewChunk (INT32 blksz);
@ -101,16 +104,18 @@ export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
export void Heap_REGTYP (Heap_Module m, INT32 typ);
export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
static void Heap_Scan (void);
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len);
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len);
export void Heap_Unlock (void);
extern void *Heap__init();
extern ADDRESS Platform_MainStackFrame;
extern ADDRESS Modules_MainStackFrame;
extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
#define Heap_ModulesHalt(code) Modules_Halt(code)
#define Heap_ModulesMainStackFrame() Modules_MainStackFrame
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
#define Heap_uLE(x, y) ((size_t)x <= (size_t)y)
#define Heap_uLT(x, y) ((size_t)x < (size_t)y)
void Heap_Lock (void)
{
@ -143,6 +148,35 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
return (void*)m;
}
INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
{
Heap_Module m, p;
__DUP(name, name__len, CHAR);
m = (Heap_Module)(ADDRESS)Heap_modules;
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m;
m = m->next;
}
if ((m != NIL && m->refcnt == 0)) {
if (m == (Heap_Module)(ADDRESS)Heap_modules) {
Heap_modules = (SYSTEM_PTR)m->next;
} else {
p->next = m->next;
}
__DEL(name);
return 0;
} else {
if (m == NIL) {
__DEL(name);
return -1;
} else {
__DEL(name);
return m->refcnt;
}
}
__RETCHK;
}
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
{
Heap_Cmd c;
@ -170,16 +204,24 @@ void Heap_INCREF (Heap_Module m)
static INT32 Heap_NewChunk (INT32 blksz)
{
INT32 chnk;
INT32 chnk, blk, end;
chnk = Heap_OSAllocate(blksz + 12);
if (chnk != 0) {
__PUT(chnk + 4, chnk + (12 + blksz), INT32);
__PUT(chnk + 12, chnk + 16, INT32);
__PUT(chnk + 16, blksz, INT32);
__PUT(chnk + 20, -4, INT32);
__PUT(chnk + 24, Heap_bigBlocks, INT32);
Heap_bigBlocks = chnk + 12;
blk = chnk + 12;
end = blk + blksz;
__PUT(chnk + 4, end, INT32);
__PUT(blk, blk + 4, INT32);
__PUT(blk + 4, blksz, INT32);
__PUT(blk + 8, -4, INT32);
__PUT(blk + 12, Heap_bigBlocks, INT32);
Heap_bigBlocks = blk;
Heap_heapsize += blksz;
if (Heap_uLT(blk + 4, Heap_heapMin)) {
Heap_heapMin = blk + 4;
}
if (Heap_uLT(Heap_heapMax, end)) {
Heap_heapMax = end;
}
}
return chnk;
}
@ -187,29 +229,28 @@ static INT32 Heap_NewChunk (INT32 blksz)
static void Heap_ExtendHeap (INT32 blksz)
{
INT32 size, chnk, j, next;
if (blksz > 160000) {
if (Heap_uLT(Heap_heapMinExpand, blksz)) {
size = blksz;
} else {
size = 160000;
size = Heap_heapMinExpand;
}
chnk = Heap_NewChunk(size);
if (chnk != 0) {
if (chnk < Heap_heap) {
if (Heap_uLT(chnk, Heap_heap)) {
__PUT(chnk, Heap_heap, INT32);
Heap_heap = chnk;
} else {
j = Heap_heap;
__GET(j, next, INT32);
while ((next != 0 && chnk > next)) {
while ((next != 0 && Heap_uLT(next, chnk))) {
j = next;
__GET(j, next, INT32);
}
__PUT(chnk, next, INT32);
__PUT(j, chnk, INT32);
}
if (next == 0) {
__GET(chnk + 4, Heap_heapend, INT32);
}
} else if (!Heap_firstTry) {
Heap_heapMinExpand = 16;
}
}
@ -219,7 +260,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
SYSTEM_PTR new;
Heap_Lock();
__GET(tag, blksz, INT32);
i0 = __ASHR(blksz, 4);
i0 = __LSH(blksz, -Heap_ldUnit, 32);
i = i0;
if (i < 9) {
adr = Heap_freeList[i];
@ -251,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
if (Heap_firstTry) {
Heap_GC(1);
blksz += 16;
if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize);
t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 32) * 80;
if (Heap_uLT(Heap_heapsize, t)) {
Heap_ExtendHeap(t - Heap_heapsize);
}
Heap_firstTry = 0;
new = Heap_NEWREC(tag);
Heap_firstTry = 1;
if (new == NIL) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize);
Heap_ExtendHeap(blksz);
new = Heap_NEWREC(tag);
}
Heap_firstTry = 1;
Heap_Unlock();
return new;
} else {
@ -269,7 +311,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
}
__GET(adr + 4, t, INT32);
if (t >= blksz) {
if (Heap_uLE(blksz, t)) {
break;
}
prev = adr;
@ -280,7 +322,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
__PUT(end + 4, blksz, INT32);
__PUT(end + 8, -4, INT32);
__PUT(end, end + 4, INT32);
if (restsize > 144) {
if (Heap_uLT(144, restsize)) {
__PUT(adr + 4, restsize, INT32);
} else {
__GET(adr + 12, next, INT32);
@ -289,7 +331,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
} else {
__PUT(prev + 12, next, INT32);
}
if (restsize > 0) {
if (restsize != 0) {
di = __ASHR(restsize, 4);
__PUT(adr + 4, restsize, INT32);
__PUT(adr + 12, Heap_freeList[di], INT32);
@ -300,7 +342,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
i = adr + 16;
end = adr + blksz;
while (i < end) {
while (Heap_uLT(i, end)) {
__PUT(i, 0, INT32);
__PUT(i + 4, 0, INT32);
__PUT(i + 8, 0, INT32);
@ -397,17 +439,17 @@ static void Heap_Scan (void)
while (chnk != 0) {
adr = chnk + 12;
__GET(chnk + 4, end, INT32);
while (adr < end) {
while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT32);
if (__ODD(tag)) {
if (freesize > 0) {
if (freesize != 0) {
start = adr - freesize;
__PUT(start, start + 4, INT32);
__PUT(start + 4, freesize, INT32);
__PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4);
i = __LSH(freesize, -Heap_ldUnit, 32);
freesize = 0;
if (i < 9) {
if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@ -426,14 +468,14 @@ static void Heap_Scan (void)
adr += size;
}
}
if (freesize > 0) {
if (freesize != 0) {
start = adr - freesize;
__PUT(start, start + 4, INT32);
__PUT(start + 4, freesize, INT32);
__PUT(start + 8, -4, INT32);
i = __ASHR(freesize, 4);
i = __LSH(freesize, -Heap_ldUnit, 32);
freesize = 0;
if (i < 9) {
if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@ -445,18 +487,19 @@ static void Heap_Scan (void)
}
}
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len)
{
INT32 i, j, x;
INT32 i, j;
INT32 x;
j = l;
x = a[j];
for (;;) {
i = j;
j = __ASHL(j, 1) + 1;
if ((j < r && a[j] < a[j + 1])) {
if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
j += 1;
}
if (j > r || a[j] <= x) {
if (j > r || Heap_uLE(a[j], x)) {
break;
}
a[i] = a[j];
@ -464,9 +507,10 @@ static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
a[i] = x;
}
static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len)
{
INT32 l, r, x;
INT32 l, r;
INT32 x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@ -482,37 +526,42 @@ static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
}
}
static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len)
static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len)
{
INT32 chnk, adr, tag, next, lim, lim1, i, ptr, size;
INT32 chnk, end, adr, tag, next, i, ptr, size;
chnk = Heap_heap;
i = 0;
lim = cand[n - 1];
while ((chnk != 0 && chnk < lim)) {
while (chnk != 0) {
__GET(chnk + 4, end, INT32);
adr = chnk + 12;
__GET(chnk + 4, lim1, INT32);
if (lim < lim1) {
lim1 = lim;
}
while (adr < lim1) {
while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT32);
if (__ODD(tag)) {
__GET(tag - 1, size, INT32);
adr += size;
} else {
__GET(tag, size, INT32);
ptr = adr + 4;
while (cand[i] < ptr) {
while (Heap_uLT(cand[i], ptr)) {
i += 1;
}
if (i == n) {
return;
}
next = adr + size;
if (cand[i] < next) {
}
} else {
__GET(tag, size, INT32);
ptr = adr + 4;
adr += size;
while (Heap_uLT(cand[i], ptr)) {
i += 1;
if (i == n) {
return;
}
}
if (Heap_uLT(cand[i], adr)) {
Heap_Mark(ptr);
}
adr = next;
}
if (Heap_uLE(end, cand[i])) {
adr = end;
}
}
__GET(chnk, chnk, INT32);
@ -571,10 +620,11 @@ void Heap_FINALL (void)
}
}
static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len)
{
SYSTEM_PTR frame;
INT32 inc, nofcand, sp, p, stack0;
INT32 nofcand;
INT32 inc, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@ -585,14 +635,14 @@ static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
if (n == 0) {
nofcand = 0;
sp = (ADDRESS)&frame;
stack0 = Heap_PlatformMainStackFrame();
stack0 = Heap_ModulesMainStackFrame();
inc = (ADDRESS)&align.p - (ADDRESS)&align;
if (sp > stack0) {
if (Heap_uLT(stack0, sp)) {
inc = -inc;
}
while (sp != stack0) {
__GET(sp, p, INT32);
if ((p > Heap_heap && p < Heap_heapend)) {
if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
@ -615,7 +665,6 @@ void Heap_GC (BOOLEAN markStack)
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 cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
Heap_Lock();
m = (Heap_Module)(ADDRESS)Heap_modules;
while (m != NIL) {
@ -688,7 +737,6 @@ void Heap_GC (BOOLEAN markStack)
Heap_Finalize();
Heap_Unlock();
}
}
void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
{
@ -703,17 +751,21 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
Heap_heap = Heap_NewChunk(128000);
__GET(Heap_heap + 4, Heap_heapend, INT32);
__PUT(Heap_heap, 0, INT32);
Heap_heap = 0;
Heap_heapsize = 0;
Heap_allocated = 0;
Heap_lockdepth = 0;
Heap_heapMin = -1;
Heap_heapMax = 0;
Heap_bigBlocks = 0;
Heap_heapMinExpand = 128000;
Heap_ldUnit = 4;
Heap_heap = Heap_NewChunk(128000);
__PUT(Heap_heap, 0, INT32);
Heap_firstTry = 1;
Heap_freeList[9] = 1;
Heap_lockdepth = 0;
Heap_FileCount = 0;
Heap_modules = NIL;
Heap_heapsize = 0;
Heap_bigBlocks = 0;
Heap_fin = NIL;
Heap_interrupted = 0;
Heap_HeapModuleInit();

View file

@ -1,16 +1,26 @@
/* voc 1.95 [2016/11/24]. 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
#define Heap__h
#include "SYSTEM.h"
typedef
struct Heap_CmdDesc *Heap_Cmd;
typedef
CHAR Heap_CmdName[24];
typedef
void (*Heap_Command)(void);
typedef
struct Heap_CmdDesc {
Heap_Cmd next;
Heap_CmdName name;
Heap_Command cmd;
} Heap_CmdDesc;
typedef
void (*Heap_EnumProc)(void(*)(SYSTEM_PTR));
@ -21,22 +31,31 @@ typedef
struct Heap_ModuleDesc *Heap_Module;
typedef
struct Heap_ModuleDesc {
INT32 _prvt0;
char _prvt1[44];
} Heap_ModuleDesc;
CHAR Heap_ModuleName[20];
typedef
CHAR Heap_ModuleName[20];
struct Heap_ModuleDesc {
Heap_Module next;
Heap_ModuleName name;
INT32 refcnt;
Heap_Cmd cmds;
INT32 types;
Heap_EnumProc enumPtrs;
char _prvt0[8];
} Heap_ModuleDesc;
import SYSTEM_PTR Heap_modules;
import INT32 Heap_allocated, Heap_heapsize;
import INT32 Heap_allocated;
import INT32 Heap_heap;
import INT32 Heap_heapsize, Heap_heapMinExpand;
import INT16 Heap_FileCount;
import ADDRESS *Heap_ModuleDesc__typ;
import ADDRESS *Heap_CmdDesc__typ;
import void Heap_FINALL (void);
import INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -9,81 +9,303 @@
#include "Heap.h"
#include "Platform.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
typedef
void (*Modules_Command)(void);
typedef
struct Modules_CmdDesc {
Modules_Cmd next;
CHAR name[24];
Modules_Command cmd;
} Modules_CmdDesc;
typedef
struct Modules_ModuleDesc *Modules_Module;
typedef
CHAR Modules_ModuleName[20];
typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
INT32 refcnt;
Modules_Cmd cmds;
INT32 types;
void (*enumPtrs)(void(*)(INT32));
INT32 reserved1, reserved2;
} Modules_ModuleDesc;
export INT16 Modules_res;
export CHAR Modules_resMsg[256];
export Modules_ModuleName Modules_imported, Modules_importing;
export Heap_ModuleName Modules_imported, Modules_importing;
export INT32 Modules_MainStackFrame;
export INT16 Modules_ArgCount;
export INT32 Modules_ArgVector;
export CHAR Modules_BinaryDir[1024];
export ADDRESS *Modules_ModuleDesc__typ;
export ADDRESS *Modules_CmdDesc__typ;
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
export INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
export void Modules_AssertFail (INT32 code);
static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len);
static void Modules_DisplayHaltCode (INT32 code);
export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len);
static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len);
export void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
export void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
export void Modules_GetIntArg (INT16 n, INT32 *val);
export void Modules_Halt (INT32 code);
export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
export void Modules_Init (INT32 argc, INT32 argvadr);
static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len);
static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len);
static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len);
export Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
export Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static void Modules_errch (CHAR c);
static void Modules_errint (INT32 l);
static void Modules_errstring (CHAR *s, LONGINT s__len);
static void Modules_errstring (CHAR *s, ADDRESS s__len);
#define Modules_modules() (Modules_Module)Heap_modules
#define Modules_setmodules(m) Heap_modules = m
extern void Heap_InitHeap();
extern void *Modules__init(void);
#define Modules_InitHeap() Heap_InitHeap()
#define Modules_ModulesInit() Modules__init()
#define Modules_modules() (Heap_Module)Heap_modules
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
void Modules_Init (INT32 argc, INT32 argvadr)
{
INT16 i, j;
__DUP(b, b__len, CHAR);
Modules_MainStackFrame = argvadr;
Modules_ArgCount = __VAL(INT16, argc);
__GET(argvadr, Modules_ArgVector, INT32);
Modules_InitHeap();
Modules_ModulesInit();
}
typedef
CHAR (*argptr__15)[1024];
void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len)
{
argptr__15 arg = NIL;
if (n < Modules_ArgCount) {
__GET(Modules_ArgVector + __ASHL(n, 2), arg, argptr__15);
__COPY(*arg, val, val__len);
}
}
void Modules_GetIntArg (INT16 n, INT32 *val)
{
CHAR s[64];
INT32 k, d, i;
s[0] = 0x00;
Modules_GetArg(n, (void*)s, 64);
i = 0;
while (a[__X(i, a__len)] != 0x00) {
if (s[0] == '-') {
i = 1;
}
k = 0;
d = (INT16)s[__X(i, 64)] - 48;
while ((d >= 0 && d <= 9)) {
k = k * 10 + d;
i += 1;
d = (INT16)s[__X(i, 64)] - 48;
}
if (s[0] == '-') {
k = -k;
i -= 1;
}
if (i > 0) {
*val = k;
}
}
INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
{
INT16 i;
CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0;
Modules_GetArg(i, (void*)arg, 256);
while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1;
Modules_GetArg(i, (void*)arg, 256);
}
__DEL(s);
return i;
}
static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
i = 0;
while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
j = 0;
while (b[__X(j, b__len)] != 0x00) {
a[__X(i, a__len)] = b[__X(j, b__len)];
__DEL(s);
return i;
}
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0;
j = Modules_CharCount(d, d__len);
while (s[__X(i, s__len)] != 0x00) {
d[__X(j, d__len)] = s[__X(i, s__len)];
i += 1;
j += 1;
}
a[__X(i, a__len)] = 0x00;
__DEL(b);
d[__X(j, d__len)] = 0x00;
__DEL(s);
}
Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
Modules_Module m = NIL;
INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0;
j = Modules_CharCount(d, d__len);
if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
d[__X(j, d__len)] = c;
j += 1;
}
while (s[__X(i, s__len)] != 0x00) {
d[__X(j, d__len)] = s[__X(i, s__len)];
i += 1;
j += 1;
}
d[__X(j, d__len)] = 0x00;
__DEL(s);
}
static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
if (c == 0x00) {
__DEL(s);
return 0;
}
i = 0;
while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
__DEL(s);
return s[__X(i, s__len)] == c;
}
static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
{
__DUP(d, d__len, CHAR);
if (d[0] == 0x00) {
__DEL(d);
return 0;
}
if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
__DEL(d);
return 1;
}
if (d[__X(1, d__len)] == ':') {
__DEL(d);
return 1;
}
__DEL(d);
return 0;
}
static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
__DUP(s, s__len, CHAR);
if (Modules_IsAbsolute(s, s__len)) {
__COPY(s, d, d__len);
} else {
__COPY(Platform_CWD, d, d__len);
Modules_AppendPart('/', s, s__len, (void*)d, d__len);
}
__DEL(s);
}
static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
{
Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__DEL(s);
return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
}
static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
{
INT16 j;
__DUP(s, s__len, CHAR);
__DUP(p, p__len, CHAR);
j = 0;
while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
d[__X(j, d__len)] = s[__X(*i, s__len)];
*i += 1;
j += 1;
}
d[__X(j, d__len)] = 0x00;
while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
*i += 1;
}
__DEL(s);
__DEL(p);
}
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
INT16 i, j;
CHAR part[1024];
__DUP(s, s__len, CHAR);
i = 0;
j = 0;
while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
i += 1;
d[__X(j, d__len)] = '/';
j += 1;
}
d[__X(j, d__len)] = 0x00;
while (s[__X(i, s__len)] != 0x00) {
Modules_ExtractPart(s, s__len, &i, (CHAR*)"/\\", 3, (void*)part, 1024);
if ((part[0] != 0x00 && __STRCMP(part, ".") != 0)) {
Modules_AppendPart('/', part, 1024, (void*)d, d__len);
}
}
__DEL(s);
}
typedef
CHAR pathstring__12[4096];
static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len)
{
pathstring__12 arg0, pathlist, pathdir, tempstr;
INT16 i, j, k;
BOOLEAN present;
if (Modules_ArgCount < 1) {
binarydir[0] = 0x00;
return;
}
Modules_GetArg(0, (void*)arg0, 4096);
i = 0;
while ((((arg0[__X(i, 4096)] != 0x00 && arg0[__X(i, 4096)] != '/')) && arg0[__X(i, 4096)] != '\\')) {
i += 1;
}
if (arg0[__X(i, 4096)] == '/' || arg0[__X(i, 4096)] == '\\') {
Modules_Trim(arg0, 4096, (void*)tempstr, 4096);
Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
present = Modules_IsFilePresent(binarydir, binarydir__len);
} else {
Platform_GetEnv((CHAR*)"PATH", 5, (void*)pathlist, 4096);
i = 0;
present = 0;
while ((!present && pathlist[__X(i, 4096)] != 0x00)) {
Modules_ExtractPart(pathlist, 4096, &i, (CHAR*)":;", 3, (void*)pathdir, 4096);
Modules_AppendPart('/', arg0, 4096, (void*)pathdir, 4096);
Modules_Trim(pathdir, 4096, (void*)tempstr, 4096);
Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
present = Modules_IsFilePresent(binarydir, binarydir__len);
}
}
if (present) {
k = Modules_CharCount(binarydir, binarydir__len);
while ((k > 0 && !Modules_IsOneOf(binarydir[__X(k - 1, binarydir__len)], (CHAR*)"/\\", 3))) {
k -= 1;
}
if (k == 0) {
binarydir[__X(k, binarydir__len)] = 0x00;
} else {
binarydir[__X(k - 1, binarydir__len)] = 0x00;
}
} else {
binarydir[0] = 0x00;
}
}
Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
{
Heap_Module m = NIL;
CHAR bodyname[64];
Modules_Command body;
Heap_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
@ -96,16 +318,16 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_res = 1;
__COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
Modules_Append((void*)Modules_resMsg, 256, name, name__len);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
}
__DEL(name);
return m;
}
Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
{
Modules_Cmd c = NIL;
Heap_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) {
@ -120,43 +342,36 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
__COPY(name, Modules_importing, 20);
Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
Modules_Append((void*)Modules_resMsg, 256, name, name__len);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
Modules_Append(mod->name, 20, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
__DEL(name);
return NIL;
}
__RETCHK;
}
void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
{
Modules_Module m = NIL, p = NIL;
Heap_Module m = NIL, p = NIL;
INT32 refcount;
__DUP(name, name__len, CHAR);
m = Modules_modules();
if (all) {
Modules_res = 1;
__MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
} else {
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m;
m = m->next;
}
if ((m != NIL && m->refcnt == 0)) {
if (m == Modules_modules()) {
Modules_setmodules(m->next);
} else {
p->next = m->next;
}
refcount = Heap_FreeModule(name, name__len);
if (refcount == 0) {
Modules_res = 0;
} else {
Modules_res = 1;
if (m == NIL) {
if (refcount < 0) {
__MOVE("module not found", Modules_resMsg, 17);
} else {
__MOVE("clients of this module exist", Modules_resMsg, 29);
}
Modules_res = 1;
}
}
__DEL(name);
@ -168,7 +383,7 @@ static void Modules_errch (CHAR c)
e = Platform_Write(1, (ADDRESS)&c, 1);
}
static void Modules_errstring (CHAR *s, LONGINT s__len)
static void Modules_errstring (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@ -189,7 +404,7 @@ static void Modules_errint (INT32 l)
if (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)
@ -250,6 +465,7 @@ static void Modules_DisplayHaltCode (INT32 code)
void Modules_Halt (INT32 code)
{
Heap_FINALL();
Modules_errstring((CHAR*)"Terminated by Halt(", 20);
Modules_errint(code);
Modules_errstring((CHAR*)"). ", 4);
@ -262,6 +478,7 @@ void Modules_Halt (INT32 code)
void Modules_AssertFail (INT32 code)
{
Heap_FINALL();
Modules_errstring((CHAR*)"Assertion failure.", 19);
if (code != 0) {
Modules_errstring((CHAR*)" ASSERT code ", 14);
@ -269,11 +486,13 @@ void Modules_AssertFail (INT32 code)
Modules_errstring((CHAR*)".", 2);
}
Modules_errstring(Platform_NL, 3);
if (code > 0) {
Platform_Exit(code);
} else {
Platform_Exit(-1);
}
}
__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 48), {0, 28, -12}};
__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 32), {0, -8}};
export void *Modules__init(void)
{
@ -281,8 +500,7 @@ export void *Modules__init(void)
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
__INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
__INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
/* BEGIN */
Modules_FindBinaryDir((void*)Modules_BinaryDir, 1024);
__ENDMOD;
}

View file

@ -1,53 +1,30 @@
/* voc 1.95 [2016/11/24]. 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
#define Modules__h
#include "SYSTEM.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
typedef
void (*Modules_Command)(void);
typedef
struct Modules_CmdDesc {
Modules_Cmd next;
CHAR name[24];
Modules_Command cmd;
} Modules_CmdDesc;
typedef
struct Modules_ModuleDesc *Modules_Module;
typedef
CHAR Modules_ModuleName[20];
typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
INT32 refcnt;
Modules_Cmd cmds;
INT32 types;
void (*enumPtrs)(void(*)(INT32));
char _prvt0[8];
} Modules_ModuleDesc;
#include "Heap.h"
import INT16 Modules_res;
import CHAR Modules_resMsg[256];
import Modules_ModuleName Modules_imported, Modules_importing;
import Heap_ModuleName Modules_imported, Modules_importing;
import INT32 Modules_MainStackFrame;
import INT16 Modules_ArgCount;
import INT32 Modules_ArgVector;
import CHAR Modules_BinaryDir[1024];
import ADDRESS *Modules_ModuleDesc__typ;
import ADDRESS *Modules_CmdDesc__typ;
import INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
import void Modules_AssertFail (INT32 code);
import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
import void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
import void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
import void Modules_GetIntArg (INT16 n, INT32 *val);
import void Modules_Halt (INT32 code);
import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
import void Modules_Init (INT32 argc, INT32 argvadr);
import Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
import Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
import void *Modules__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -253,7 +253,7 @@ OPT_Node OPB_NewString (OPS_String str, INT64 len)
x->conval->intval = -1;
x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
__COPY(str, *x->conval->ext, 256);
__MOVE(str, *x->conval->ext, 256);
return x;
}
@ -261,7 +261,7 @@ static void OPB_CharToString (OPT_Node n)
{
CHAR ch;
n->typ = OPT_stringtyp;
ch = (CHAR)n->conval->intval;
ch = __CHR(n->conval->intval);
n->conval->ext = OPT_NewExt();
if (ch == 0x00) {
n->conval->intval2 = 1;
@ -550,7 +550,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
if (f == 4) {
if (z->conval->intval == (-9223372036854775807-1)) {
if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
@ -577,7 +577,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
if (f == 4) {
if (z->conval->intval == (-9223372036854775807-1)) {
if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = __ABS(z->conval->intval);
@ -597,7 +597,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
case 22:
if (f == 3) {
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;
} else {
z = NewOp__29(op, typ, z);
@ -920,7 +920,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
if (f == 4) {
xv = xval->intval;
yv = yval->intval;
if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807LL, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807LL-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807LL-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807LL-1))) && yv != (-9223372036854775807LL-1))) && -xv <= __DIV(9223372036854775807LL, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
@ -999,8 +999,8 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 6:
if (f == 4) {
temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807LL - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
@ -1023,7 +1023,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 7:
if (f == 4) {
if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203);
r = (LONGREAL)1;
}
(*x)->conval->intval = (INT32)__ENTIER(r);
(*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL);
OPB_SetIntType(*x);
}
}
@ -1624,23 +1624,20 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
g = 8;
}
if (x == y) {
} else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) {
} else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) {
OPB_err(113);
} else if (x->BaseTyp == OPT_chartyp) {
if (g == 8) {
if (ynode->conval->intval2 > x->n) {
OPB_err(114);
}
} else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
} else {
OPB_err(113);
}
} else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
} else if (x->comp == 4) {
if (x == y) {
} else if (y->comp == 4) {
@ -2091,7 +2088,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, (INT64)__ASH(1, x->conval->intval))) {
if (__ABS(p->conval->intval) <= __DIV(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
} else {
OPB_err(208);
@ -2536,7 +2533,6 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@ -2562,13 +2558,8 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
y->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(0));
}
if ((((((__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c, 32))) && y->typ->BaseTyp == OPT_chartyp)) {
subcl = 18;
} else {
subcl = 0;
}
OPB_BindNodes(19, OPT_notyp, &*x, y);
(*x)->subcl = subcl;
(*x)->subcl = 0;
}
void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
@ -2595,7 +2586,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
OPB_maxExp = OPB_log(4611686018427387904);
OPB_maxExp = OPB_log(4611686018427387904LL);
OPB_maxExp = OPB_exp;
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPB__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -56,7 +56,7 @@ static void OPC_GenHeaderMsg (void);
export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
static void OPC_IdentList (OPT_Object obj, INT16 vis);
static void OPC_Include (CHAR *name, LONGINT name__len);
static void OPC_Include (CHAR *name, ADDRESS name__len);
static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
export void OPC_Indent (INT16 count);
@ -68,11 +68,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
export void OPC_IntLiteral (INT64 n, INT32 size);
export void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName);
static INT16 OPC_Length (CHAR *s, LONGINT s__len);
static INT16 OPC_Length (CHAR *s, ADDRESS s__len);
export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
export INT32 OPC_NofPtrs (OPT_Struct typ);
static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
@ -80,8 +80,8 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l);
static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
@ -137,7 +137,7 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
{
CHAR ch;
INT16 i;
@ -156,7 +156,7 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
__DEL(s);
}
static INT16 OPC_Length (CHAR *s, LONGINT s__len)
static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@ -166,7 +166,7 @@ static INT16 OPC_Length (CHAR *s, LONGINT s__len)
return i;
}
static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
{
INT16 i, h;
i = 0;
@ -364,7 +364,7 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
OPC_Str1((CHAR*)"ADDRESS len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
@ -511,7 +511,7 @@ static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamNa
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
OPM_WriteString((CHAR*)", LONGINT ", 11);
OPM_WriteString((CHAR*)", ADDRESS ", 11);
} else {
OPM_WriteString((CHAR*)", ", 3);
}
@ -618,7 +618,8 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
{
if (obj != NIL) {
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))) {
if (OPM_currFile == 1 || (OPM_currFile == 0 && obj->vis == 1)) {
OPM_WriteString((CHAR*)"#define __", 11);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
@ -644,6 +645,7 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
OPM_Write(')');
OPM_WriteLn();
}
}
OPC_DefineTProcMacros(obj->right, &*empty);
}
}
@ -652,7 +654,7 @@ static void OPC_DefineType (OPT_Struct str)
{
OPT_Object obj = NIL, field = NIL, par = NIL;
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;
if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) {
@ -681,6 +683,10 @@ static void OPC_DefineType (OPT_Struct str)
OPC_DefineType(str->BaseTyp);
}
} 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);
} else if (str->form == 12) {
if (str->BaseTyp != OPT_notyp) {
@ -715,12 +721,19 @@ static void OPC_DefineType (OPT_Struct str)
if (!empty) {
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();
}
}
}
}
}
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
{
INT16 i;
__DUP(y, y__len, CHAR);
@ -968,8 +981,8 @@ static void OPC_IdentList (OPT_Object obj, INT16 vis)
if (obj->typ->comp == 3) {
OPC_EndStat();
OPC_BegStat();
base = OPT_linttyp;
OPM_WriteString((CHAR*)"LONGINT ", 9);
base = OPT_adrtyp;
OPM_WriteString((CHAR*)"ADDRESS ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
@ -1008,7 +1021,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
__COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
OPM_WriteString((CHAR*)", LONGINT ", 11);
OPM_WriteString((CHAR*)", ADDRESS ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPM_WriteString((CHAR*)", ADDRESS *", 12);
@ -1062,7 +1075,7 @@ static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
}
}
static void OPC_Include (CHAR *name, LONGINT name__len)
static void OPC_Include (CHAR *name, ADDRESS name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", 10);
@ -1138,7 +1151,7 @@ static void OPC_GenHeaderMsg (void)
OPM_WriteString((CHAR*)"/* ", 4);
OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, 75);
OPM_WriteString(Configuration_versionLong, 76);
OPM_Write(' ');
i = 0;
while (i <= 31) {
@ -1659,9 +1672,9 @@ void OPC_CompleteIdent (OPT_Object obj)
OPC_Ident(obj);
OPM_WriteString((CHAR*)"__", 3);
} else {
OPM_WriteString((CHAR*)"((", 3);
OPM_WriteString((CHAR*)"(*(", 4);
OPC_Ident(obj->typ->strobj);
OPM_Write(')');
OPM_WriteString((CHAR*)"*)&", 4);
OPC_Ident(obj);
OPM_Write(')');
}
@ -1739,12 +1752,12 @@ static void OPC_CharacterLiteral (INT64 c)
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write(__CHR(c));
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
{
INT32 i;
INT16 c;
@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
OPM_Write(__CHR(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
OPM_Write(__CHR(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c));
OPM_Write(__CHR(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write(__CHR(c));
}
i += 1;
}
@ -1830,6 +1843,12 @@ void OPC_IntLiteral (INT64 n, INT32 size)
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) {
OPC_CompleteIdent(obj);
OPM_WriteString((CHAR*)"__len", 6);
@ -1837,10 +1856,6 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
OPM_WriteInt(dim);
}
} else {
while (dim > 0) {
array = array->BaseTyp;
dim -= 1;
}
OPM_WriteInt(array->n);
}
}
@ -1912,9 +1927,9 @@ static struct InitKeywords__46 {
struct InitKeywords__46 *lnk;
} *InitKeywords__46_s;
static void Enter__47 (CHAR *s, LONGINT s__len);
static void Enter__47 (CHAR *s, ADDRESS s__len);
static void Enter__47 (CHAR *s, LONGINT s__len)
static void Enter__47 (CHAR *s, ADDRESS s__len)
{
INT16 h;
__DUP(s, s__len, CHAR);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPC__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -8,6 +8,7 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@ -18,6 +19,8 @@ typedef
CHAR OPM_FileName[32];
static CHAR OPM_currentComment[256];
static BOOLEAN OPM_hasComment;
static CHAR OPM_SourceFileName[256];
static CHAR OPM_GlobalModel[10];
export CHAR OPM_Model[10];
@ -26,7 +29,7 @@ export INT16 OPM_AddressSize;
static INT16 OPM_GlobalAlignment;
export INT16 OPM_Alignment;
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 LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
@ -41,41 +44,48 @@ static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
static INT16 OPM_S;
export CHAR OPM_InstallDir[1024];
export CHAR OPM_ResourceDir[1024];
static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
export void OPM_DeleteNewSym (void);
export void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_FPrint (INT32 *fp, INT64 val);
export void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
export void OPM_FPrintReal (INT32 *fp, REAL val);
export void OPM_FPrintSet (INT32 *fp, UINT64 val);
static void OPM_FindInstallDir (void);
static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch);
export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
export void OPM_GetComment (CHAR *text, ADDRESS text__len);
export void OPM_Init (BOOLEAN *done);
export void OPM_InitOptions (void);
export INT16 OPM_Integer (INT64 n);
static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len);
export void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
static void OPM_LogErrMsg (INT16 n);
export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
export void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
export void OPM_LogWNum (INT64 i, INT64 len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
export void OPM_LogWStr (CHAR *s, ADDRESS s__len);
export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
export void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
export void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
static void OPM_ScanOptions (CHAR *s, LONGINT s__len);
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len);
static void OPM_ShowLine (INT64 pos);
export INT64 OPM_SignedMaximum (INT32 bytecount);
export INT64 OPM_SignedMinimum (INT32 bytecount);
export void OPM_StoreComment (CHAR *text, ADDRESS text__len);
export void OPM_SymRCh (CHAR *ch);
export INT32 OPM_SymRInt (void);
export INT64 OPM_SymRInt64 (void);
@ -87,14 +97,13 @@ export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
export void OPM_SymWSet (UINT64 s);
static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
export void OPM_WriteHex (INT64 i);
export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export void OPM_WriteString (CHAR *s, ADDRESS s__len);
export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);
@ -105,7 +114,7 @@ void OPM_LogW (CHAR ch)
Out_Char(ch);
}
void OPM_LogWStr (CHAR *s, LONGINT s__len)
void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{
__DUP(s, s__len, CHAR);
Out_String(s, s__len);
@ -122,7 +131,7 @@ void OPM_LogWLn (void)
Out_Ln();
}
void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
@ -131,6 +140,57 @@ void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
__DEL(vt100code);
}
void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
{
__DUP(modname, modname__len, CHAR);
OPM_LogWStr((CHAR*)"Compiling ", 11);
OPM_LogWStr(modname, modname__len);
if (__IN(18, OPM_Options, 32)) {
OPM_LogWStr((CHAR*)", s:", 5);
OPM_LogWNum(__ASHL(OPM_ShortintSize, 3), 1);
OPM_LogWStr((CHAR*)" i:", 4);
OPM_LogWNum(__ASHL(OPM_IntegerSize, 3), 1);
OPM_LogWStr((CHAR*)" l:", 4);
OPM_LogWNum(__ASHL(OPM_LongintSize, 3), 1);
OPM_LogWStr((CHAR*)" adr:", 6);
OPM_LogWNum(__ASHL(OPM_AddressSize, 3), 1);
OPM_LogWStr((CHAR*)" algn:", 7);
OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
}
OPM_LogW('.');
__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 result;
@ -154,7 +214,7 @@ INT16 OPM_Integer (INT64 n)
return __VAL(INT16, n);
}
static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@ -227,29 +287,6 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
i += 2;
}
break;
case 'B':
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
}
__ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
__ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
__ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
if (OPM_IntegerSize == 2) {
OPM_LongintSize = 4;
} else {
OPM_LongintSize = 8;
}
Files_SetSearchPath((CHAR*)"", 1);
break;
default:
OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
@ -266,16 +303,19 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
BOOLEAN OPM_OpenPar (void)
{
CHAR s[256];
if (Platform_ArgCount == 1) {
if (Modules_ArgCount == 1) {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
OPM_LogWStr(Configuration_versionLong, 75);
OPM_LogWStr(Configuration_versionLong, 76);
OPM_LogW('.');
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Further development by Norayr Chilingarian, David Brown and others.", 68);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Loaded from ", 13);
OPM_LogWStr(Modules_BinaryDir, 1024);
OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
@ -332,7 +372,7 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn();
OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
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_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn();
@ -362,64 +402,38 @@ BOOLEAN OPM_OpenPar (void)
OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
}
OPM_GlobalAddressSize = OPM_AddressSize;
OPM_GlobalAlignment = OPM_Alignment;
__COPY(OPM_Model, OPM_GlobalModel, 10);
__MOVE(OPM_Model, OPM_GlobalModel, 10);
OPM_GlobalOptions = OPM_Options;
return 1;
}
__RETCHK;
}
static void OPM_VerboseListSizes (void)
{
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Type Size", 15);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SHORTINT ", 12);
OPM_LogWNum(OPM_ShortintSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"INTEGER ", 12);
OPM_LogWNum(OPM_IntegerSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"LONGINT ", 12);
OPM_LogWNum(OPM_LongintSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SET ", 12);
OPM_LogWNum(OPM_LongintSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"ADDRESS ", 12);
OPM_LogWNum(OPM_AddressSize, 4);
OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Alignment: ", 12);
OPM_LogWNum(OPM_Alignment, 4);
OPM_LogWLn();
}
void OPM_InitOptions (void)
{
CHAR s[256];
CHAR searchpath[1024], modules[1024];
CHAR MODULES[1024];
OPM_Options = OPM_GlobalOptions;
__COPY(OPM_GlobalModel, OPM_Model, 10);
__MOVE(OPM_GlobalModel, OPM_Model, 10);
OPM_Alignment = OPM_GlobalAlignment;
OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
}
if (__IN(15, OPM_Options, 32)) {
OPM_Options |= __SETOF(10,32);
@ -430,29 +444,32 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
case 'C':
OPM_ShortintSize = 2;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 4;
break;
case 'V':
OPM_ShortintSize = 1;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 8;
break;
default:
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
}
if (__IN(18, OPM_Options, 32)) {
OPM_VerboseListSizes();
}
OPM_ResourceDir[0] = 0x00;
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
if (OPM_ResourceDir[0] != 0x00) {
Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
}
modules[0] = 0x00;
Platform_GetEnv((CHAR*)"MODULES", 8, (void*)modules, 1024);
__MOVE(".", searchpath, 2);
@ -465,23 +482,22 @@ void OPM_InitOptions (void)
Files_SetSearchPath(searchpath, 1024);
}
void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
void OPM_Init (BOOLEAN *done)
{
Texts_Text T = NIL;
INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
if (OPM_S >= Platform_ArgCount) {
if (OPM_S >= Modules_ArgCount) {
return;
}
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
Texts_Open(T, s, 256);
OPM_LogWStr(s, 256);
OPM_LogWStr((CHAR*)" ", 3);
__COPY(s, mname, mname__len);
__COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
OPM_LogWStr(s, 256);
@ -503,18 +519,14 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
void OPM_Get (CHAR *ch)
{
Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
if (*ch == 0x0d) {
OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
} else {
OPM_curpos += 1;
}
Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
if ((*ch < 0x09 && !OPM_inR.eot)) {
*ch = ' ';
}
}
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
{
INT16 i, j;
CHAR ch;
@ -632,7 +644,7 @@ static void OPM_ShowLine (INT64 pos)
if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1;
}
i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768);
while (i > 0) {
OPM_LogW(' ');
i -= 1;
@ -640,7 +652,6 @@ static void OPM_ShowLine (INT64 pos)
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
OPM_LogVT100((CHAR*)"0m", 3);
Files_Close(f);
}
void OPM_Mark (INT16 n, INT32 pos)
@ -700,7 +711,7 @@ void OPM_err (INT16 n)
OPM_Mark(n, OPM_errpos);
}
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
{
INT16 i;
INT32 l;
@ -772,10 +783,13 @@ void OPM_CloseOldSym (void)
Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
{
CHAR tag, ver;
OPM_FileName fileName;
INT16 res;
OPM_oldSFile = NIL;
*done = 0;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
@ -783,8 +797,10 @@ void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
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*)&ver);
if (tag != 0xf7 || ver != 0x82) {
if (tag != 0xf7 || ver != 0x84) {
if (!__IN(4, OPM_Options, 32)) {
OPM_err(-306);
}
OPM_CloseOldSym();
*done = 0;
}
@ -828,11 +844,23 @@ void OPM_RegisterNewSym (void)
}
}
void OPM_DeleteNewSym (void)
void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
{
OPM_FileName fn;
INT16 res;
OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
Files_Delete(fn, 32, &res);
}
void OPM_NewSym (CHAR *modName, LONGINT modName__len)
void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len)
{
OPM_FileName fn;
INT16 res;
OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".o", 3);
Files_Delete(fn, 32, &res);
}
void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
{
OPM_FileName fileName;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
@ -840,7 +868,7 @@ void OPM_NewSym (CHAR *modName, LONGINT modName__len)
if (OPM_newSFile != NIL) {
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, 0x82);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
} else {
OPM_err(153);
}
@ -851,7 +879,7 @@ void OPM_Write (CHAR ch)
Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
void OPM_WriteString (CHAR *s, LONGINT s__len)
void OPM_WriteString (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@ -861,7 +889,7 @@ void OPM_WriteString (CHAR *s, LONGINT s__len)
Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@ -875,17 +903,17 @@ void OPM_WriteHex (INT64 i)
{
CHAR s[3];
INT32 digit;
digit = __ASHR((INT32)i, 4);
digit = __ASHR(__SHORT(i, 2147483648LL), 4);
if (digit < 10) {
s[0] = (CHAR)(48 + digit);
s[0] = __CHR(48 + digit);
} 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) {
s[1] = (CHAR)(48 + digit);
s[1] = __CHR(48 + digit);
} else {
s[1] = (CHAR)(87 + digit);
s[1] = __CHR(87 + digit);
}
s[2] = 0x00;
OPM_WriteString(s, 3);
@ -893,7 +921,7 @@ void OPM_WriteHex (INT64 i)
void OPM_WriteInt (INT64 i)
{
CHAR s[24];
CHAR s[26];
INT64 i1, k;
if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
@ -901,21 +929,27 @@ void OPM_WriteInt (INT64 i)
OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
s[0] = (CHAR)(__MOD(i1, 10) + 48);
if (i1 <= 2147483647) {
k = 0;
} else {
__MOVE("LL", s, 3);
k = 2;
}
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k = 1;
k += 1;
while (i1 > 0) {
s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
s[__X(k, 24)] = '-';
s[__X(k, 26)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
OPM_Write(s[__X(k, 24)]);
OPM_Write(s[__X(k, 26)]);
}
}
}
@ -928,13 +962,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
CHAR s[32];
CHAR ch;
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') {
OPM_WriteString((CHAR*)"(REAL)", 7);
} else {
OPM_WriteString((CHAR*)"(LONGREAL)", 11);
}
OPM_WriteInt((INT32)__ENTIER(r));
OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {
@ -986,9 +1020,9 @@ static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
}
}
void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
{
CHAR FName[32];
OPM_FileName FName;
__COPY(moduleName, OPM_modName, 32);
OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
@ -1014,7 +1048,7 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
CHAR FName[32];
OPM_FileName FName;
INT16 res;
if (OPM_noerr) {
OPM_LogWStr((CHAR*)" ", 3);
@ -1050,6 +1084,59 @@ void OPM_CloseFiles (void)
Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
{
CHAR testpath[4096];
Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0;
}
__COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0;
}
__COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0;
}
__DEL(s);
return 1;
}
static void OPM_FindInstallDir (void)
{
INT16 i;
__COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
Strings_Append((CHAR*)"/", 2, (void*)OPM_InstallDir, 1024);
Strings_Append((CHAR*)"voc", 4, (void*)OPM_InstallDir, 1024);
Strings_Append((CHAR*)".d", 3, (void*)OPM_InstallDir, 1024);
if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
return;
}
__COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
i = Strings_Length(OPM_InstallDir, 1024);
while ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] != '/')) {
i -= 1;
}
if ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] == '/')) {
OPM_InstallDir[__X(i - 1, 1024)] = 0x00;
if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
return;
}
}
__COPY("", OPM_InstallDir, 1024);
}
static void EnumPtrs(void (*P)(void*))
{
__ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P);
@ -1071,6 +1158,7 @@ export void *OPM__init(void)
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Files);
__MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
@ -1079,7 +1167,6 @@ export void *OPM__init(void)
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
__REGCMD("DeleteNewSym", OPM_DeleteNewSym);
__REGCMD("InitOptions", OPM_InitOptions);
__REGCMD("LogWLn", OPM_LogWLn);
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
@ -1089,5 +1176,8 @@ export void *OPM__init(void)
OPM_MaxLReal = 1.79769296342094e+308;
OPM_MinReal = -OPM_MaxReal;
OPM_MinLReal = -OPM_MaxLReal;
OPM_FindInstallDir();
OPM_hasComment = 0;
OPM_currentComment[0] = 0x00;
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPM__h
@ -9,7 +9,7 @@
import CHAR OPM_Model[10];
import INT16 OPM_AddressSize, OPM_Alignment;
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 LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
@ -17,34 +17,39 @@ import INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
import INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
import CHAR OPM_modName[32];
import CHAR OPM_objname[64];
import CHAR OPM_InstallDir[1024];
import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
import void OPM_DeleteNewSym (void);
import void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
import void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
import void OPM_FPrint (INT32 *fp, INT64 val);
import void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
import void OPM_FPrintReal (INT32 *fp, REAL val);
import void OPM_FPrintSet (INT32 *fp, UINT64 val);
import void OPM_Get (CHAR *ch);
import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
import void OPM_GetComment (CHAR *text, ADDRESS text__len);
import void OPM_Init (BOOLEAN *done);
import void OPM_InitOptions (void);
import INT16 OPM_Integer (INT64 n);
import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
import void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
import void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
import void OPM_LogWNum (INT64 i, INT64 len);
import void OPM_LogWStr (CHAR *s, LONGINT s__len);
import void OPM_LogWStr (CHAR *s, ADDRESS s__len);
import INT32 OPM_Longint (INT64 n);
import void OPM_Mark (INT16 n, INT32 pos);
import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
import void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
import void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void);
import INT64 OPM_SignedMaximum (INT32 bytecount);
import INT64 OPM_SignedMinimum (INT32 bytecount);
import void OPM_StoreComment (CHAR *text, ADDRESS text__len);
import void OPM_SymRCh (CHAR *ch);
import INT32 OPM_SymRInt (void);
import INT64 OPM_SymRInt64 (void);
@ -61,8 +66,8 @@ import void OPM_WriteHex (INT64 i);
import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
import void OPM_WriteString (CHAR *s, LONGINT s__len);
import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
import void OPM_WriteString (CHAR *s, ADDRESS s__len);
import void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
import BOOLEAN OPM_eofSF (void);
import void OPM_err (INT16 n);
import void *OPM__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -527,7 +527,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
__COPY(OPS_name, name, 256);
__MOVE(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
if ((*x)->typ->form == 11) {
@ -634,7 +634,7 @@ static void OPP_StandProcCall (OPT_Node *x)
OPT_Node y = NIL;
INT8 m;
INT16 n;
m = (INT8)((INT16)(*x)->obj->adr);
m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128);
n = 0;
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@ -867,7 +867,7 @@ static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct
} else {
*mode = 1;
}
__COPY(OPS_name, name, 256);
__MOVE(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@ -943,7 +943,7 @@ static void GetCode__19 (void)
(*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
n += 1;
}
(*ext)[0] = (CHAR)n;
(*ext)[0] = __CHR(n);
OPS_Get(&OPP_sym);
} else {
for (;;) {
@ -956,14 +956,14 @@ static void GetCode__19 (void)
n = 1;
}
OPS_Get(&OPP_sym);
(*ext)[__X(n, 256)] = (CHAR)c;
(*ext)[__X(n, 256)] = __CHR(c);
}
if (OPP_sym == 19) {
OPS_Get(&OPP_sym);
} else if (OPP_sym == 35) {
OPP_err(19);
} else {
(*ext)[0] = (CHAR)n;
(*ext)[0] = __CHR(n);
break;
}
}
@ -1030,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
__COPY(OPS_name, *ProcedureDeclaration__16_s->name, 256);
__MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
OPP_CheckMark(&*ProcedureDeclaration__16_s->vis);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc);
@ -1129,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
__COPY(OPS_name, name, 256);
__MOVE(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@ -1665,6 +1665,9 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
obj->typ = OPT_undftyp;
OPP_CheckMark(&obj->vis);
if (OPP_sym == 9) {
if (((((((((__STRCMP(obj->name, "SHORTINT") == 0 || __STRCMP(obj->name, "INTEGER") == 0) || __STRCMP(obj->name, "LONGINT") == 0) || __STRCMP(obj->name, "HUGEINT") == 0) || __STRCMP(obj->name, "REAL") == 0) || __STRCMP(obj->name, "LONGREAL") == 0) || __STRCMP(obj->name, "SET") == 0) || __STRCMP(obj->name, "CHAR") == 0) || __STRCMP(obj->name, "TRUE") == 0) || __STRCMP(obj->name, "FALSE") == 0) {
OPM_Mark(-310, OPM_curpos);
}
OPS_Get(&OPP_sym);
OPP_TypeDecl(&obj->typ, &obj->typ);
} else if (OPP_sym == 34 || OPP_sym == 20) {
@ -1790,30 +1793,10 @@ void OPP_Module (OPT_Node *prog, UINT32 opt)
if (OPP_sym == 63) {
OPS_Get(&OPP_sym);
} else {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" sym: ", 15);
OPM_LogWNum(OPP_sym, 1);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.name: ", 15);
OPM_LogWStr(OPS_name, 256);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.str: ", 15);
OPM_LogWStr(OPS_str, 256);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
OPM_LogWNum(OPS_numtyp, 1);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
OPM_LogWNum(OPS_intval, 1);
OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
OPM_LogWStr((CHAR*)"compiling ", 11);
OPM_LogWStr(OPS_name, 256);
OPM_LogW('.');
OPM_LogCompiling(OPS_name, 256);
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
OPP_CheckSym(39);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPP__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym)
OPS_err(241);
break;
}
OPS_str[i] = OPS_ch;
OPS_str[__X(i, 256)] = OPS_ch;
i += 1;
}
OPM_Get(&OPS_ch);
OPS_str[i] = 0x00;
OPS_str[__X(i, 256)] = 0x00;
OPS_intval = i + 1;
if (OPS_intval == 2) {
*sym = 35;
@ -76,7 +76,7 @@ static void OPS_Identifier (INT8 *sym)
INT16 i;
i = 0;
do {
OPS_name[i] = OPS_ch;
OPS_name[__X(i, 256)] = OPS_ch;
i += 1;
OPM_Get(&OPS_ch);
} 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);
i -= 1;
}
OPS_name[i] = 0x00;
OPS_name[__X(i, 256)] = 0x00;
*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 (m > 0 || OPS_ch != '0') {
if (n < 24) {
dig[n] = OPS_ch;
dig[__X(n, 24)] = OPS_ch;
n += 1;
}
m += 1;
@ -173,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1;
if (n <= 2) {
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;
}
} else {
@ -187,7 +187,7 @@ static void OPS_Number (void)
OPS_intval = -1;
}
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;
}
} else {
@ -196,9 +196,9 @@ static void OPS_Number (void)
} else {
OPS_numtyp = 2;
while (i < n) {
d = Ord__7(dig[i], 0);
d = Ord__7(dig[__X(i, 24)], 0);
i += 1;
if (OPS_intval <= __DIV(9223372036854775807 - (INT64)d, 10)) {
if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
@ -214,7 +214,7 @@ static void OPS_Number (void)
expCh = 'E';
while (n > 0) {
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') {
expCh = OPS_ch;
@ -279,32 +279,74 @@ static void Comment__2 (void);
static void Comment__2 (void)
{
OPM_Get(&OPS_ch);
for (;;) {
for (;;) {
while (OPS_ch == '(') {
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);
if (OPS_ch == '*') {
Comment__2();
}
}
if (OPS_ch == '*') {
isExported = 1;
OPM_Get(&OPS_ch);
break;
}
if (OPS_ch == 0x00) {
break;
}
OPM_Get(&OPS_ch);
}
if (OPS_ch == ')') {
commentText[0] = 0x00;
OPM_StoreComment(commentText, 256);
OPM_Get(&OPS_ch);
break;
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);
} else {
prevCh = 0x00;
}
} else {
if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
}
}
prevCh = OPS_ch;
}
if (nestLevel > 0) {
OPM_Get(&OPS_ch);
}
}
if (OPS_ch == 0x00) {
OPS_err(5);
break;
}
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 (isExported) {
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 1.95 [2016/11/24]. 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
#define OPS__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -49,6 +49,15 @@ typedef
INT8 glbmno[64];
} OPT_ImpCtxt;
typedef
struct OPT_LinkDesc *OPT_Link;
typedef
struct OPT_LinkDesc {
OPS_Name name;
OPT_Link next;
} OPT_LinkDesc;
typedef
struct OPT_NodeDesc *OPT_Node;
@ -74,6 +83,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -101,6 +111,7 @@ static OPT_ExpCtxt OPT_expCtxt;
static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
static INT32 OPT_recno;
export OPT_Link OPT_Links;
export ADDRESS *OPT_ConstDesc__typ;
export ADDRESS *OPT_ObjDesc__typ;
@ -108,6 +119,7 @@ export ADDRESS *OPT_StrDesc__typ;
export ADDRESS *OPT_NodeDesc__typ;
export ADDRESS *OPT_ImpCtxt__typ;
export ADDRESS *OPT_ExpCtxt__typ;
export ADDRESS *OPT_LinkDesc__typ;
export void OPT_Align (INT32 *adr, INT32 base);
export INT32 OPT_BaseAlignment (OPT_Struct typ);
@ -120,7 +132,7 @@ static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res);
export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len);
export void OPT_FPrintObj (OPT_Object obj);
static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
@ -131,8 +143,9 @@ export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
static void OPT_InLinks (void);
static void OPT_InMod (INT8 *mno);
static void OPT_InName (CHAR *name, LONGINT name__len);
static void OPT_InName (CHAR *name, ADDRESS name__len);
static OPT_Object OPT_InObj (INT8 mno);
static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par);
static void OPT_InStruct (OPT_Struct *typ);
@ -154,12 +167,14 @@ export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
static void OPT_OutLinks (void);
static void OPT_OutMod (INT16 mno);
static void OPT_OutName (CHAR *name, LONGINT name__len);
static void OPT_OutName (CHAR *name, ADDRESS name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
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_ShorterOrLongerType (OPT_Struct x, INT16 dir);
export INT32 OPT_SizeAlignment (INT32 size);
@ -339,7 +354,7 @@ void OPT_TypSize (OPT_Struct typ)
}
typ->size = offset;
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) {
OPT_TypSize(typ->BaseTyp);
typ->size = typ->n * typ->BaseTyp->size;
@ -375,6 +390,10 @@ OPT_Object OPT_NewObj (void)
{
OPT_Object obj = NIL;
__NEW(obj, OPT_ObjDesc);
obj->typ = NIL;
obj->conval = NIL;
obj->comment = NIL;
obj->name[0] = 0x00;
return obj;
}
@ -434,14 +453,16 @@ void OPT_Init (OPS_Name name, UINT32 opt)
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
__COPY(name, OPT_SelfName, 256);
__COPY(name, OPT_topScope->name, 256);
__MOVE(name, OPT_SelfName, 256);
__MOVE(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
OPT_newsf = __IN(4, opt, 32);
OPT_findpc = __IN(8, opt, 32);
OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
__NEW(OPT_Links, OPT_LinkDesc);
__MOVE(name, OPT_Links->name, 256);
}
void OPT_Close (void)
@ -539,6 +560,8 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
OPT_Object ob0 = NIL, ob1 = NIL;
BOOLEAN left;
INT8 mnolev;
CHAR commentText[256];
INT16 j;
ob0 = OPT_topScope;
ob1 = ob0->right;
left = 0;
@ -570,13 +593,23 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
__COPY(name, ob1->name, 256);
mnolev = OPT_topScope->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;
}
}
*obj = ob1;
}
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -957,7 +990,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
}
}
static void OPT_InName (CHAR *name, LONGINT name__len)
static void OPT_InName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -1011,6 +1044,26 @@ static void OPT_InMod (INT8 *mno)
}
}
static void OPT_InLinks (void)
{
OPS_Name linkname;
OPT_Link l = NIL;
OPT_InName((void*)linkname, 256);
while (linkname[0] != 0x00) {
l = OPT_Links;
while ((l != NIL && __STRCMP(l->name, linkname) != 0)) {
l = l->next;
}
if (l == NIL) {
l = OPT_Links;
__NEW(OPT_Links, OPT_LinkDesc);
OPT_Links->next = l;
__MOVE(linkname, OPT_Links->name, 256);
}
OPT_InName((void*)linkname, 256);
}
}
static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
@ -1068,6 +1121,13 @@ static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
tag = OPM_SymRInt();
last = NIL;
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->mnolev = -mno;
if (last == NIL) {
@ -1186,7 +1246,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
*typ = OPT_NewStr(0, 1);
} else {
__COPY(name, obj->name, 256);
__MOVE(name, obj->name, 256);
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
@ -1216,7 +1276,7 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0;
tag = OPM_SymRInt();
if (tag == 35) {
(*typ)->sysflag = (INT16)OPM_SymRInt();
(*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768);
tag = OPM_SymRInt();
}
switch (tag) {
@ -1346,7 +1406,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPT_Struct typ = NIL;
INT32 tag;
OPT_ConstExt ext = NIL;
OPS_Name commentText;
BOOLEAN hasComment;
INT16 j;
INT32 len;
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) {
OPT_InStruct(&typ);
obj = typ->strobj;
@ -1362,7 +1452,7 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval);
obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) {
} else if ((tag >= 31 && tag <= 33)) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link);
@ -1377,8 +1467,8 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->mode = 9;
ext = OPT_NewExt();
obj->conval->ext = ext;
s = (INT16)OPM_SymRInt();
(*ext)[0] = (CHAR)s;
s = __SHORTF(OPM_SymRInt(), 32768);
(*ext)[0] = __CHR(s);
i = 1;
while (i <= s) {
OPM_SymRCh(&(*ext)[__X(i, 256)]);
@ -1389,20 +1479,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return NIL;
break;
}
} else if (tag == 20) {
obj->mode = 5;
OPT_InStruct(&obj->typ);
} else {
} else if (tag == 21 || tag == 22) {
obj->mode = 1;
if (tag == 22) {
obj->vis = 2;
}
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);
}
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);
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
@ -1458,9 +1565,15 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
OPM_DeleteSym((void*)name, 256);
*done = 0;
} else {
OPM_OldSym((void*)name, 256, &*done);
}
if (*done) {
OPT_InMod(&mno);
OPT_InLinks();
OPT_impCtxt.nextTag = OPM_SymRInt();
while (!OPM_eofSF()) {
obj = OPT_InObj(mno);
@ -1483,7 +1596,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
}
static void OPT_OutName (CHAR *name, LONGINT name__len)
static void OPT_OutName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -1507,6 +1620,17 @@ static void OPT_OutMod (INT16 mno)
}
}
static void OPT_OutLinks (void)
{
OPT_Link l = NIL;
l = OPT_Links;
while (l != NIL) {
OPT_OutName((void*)l->name, 256);
l = l->next;
}
OPM_SymWCh(0x00);
}
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
INT32 i, j, n;
@ -1700,7 +1824,7 @@ static void OPT_OutConstant (OPT_Object obj)
OPM_SymWInt(f);
switch (f) {
case 2: case 3:
OPM_SymWCh((CHAR)obj->conval->intval);
OPM_SymWCh(__CHR(obj->conval->intval));
break;
case 4:
OPM_SymWInt(obj->conval->intval);
@ -1728,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)
{
INT16 i, j;
OPT_ConstExt ext = NIL;
INT16 k, l;
if (obj != NIL) {
OPT_OutObj(obj->left);
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) {
OPT_FPrintErr(obj, 250);
} else if (obj->vis != 0) {
@ -1833,6 +1984,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
if (OPM_noerr) {
OPM_SymWInt(16);
OPT_OutName((void*)OPT_SelfName, 256);
OPT_OutLinks();
OPT_expCtxt.reffp = 0;
OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
@ -1854,7 +2006,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_newsf = 0;
OPT_symNew = 0;
if (!OPM_noerr || OPT_findpc) {
OPM_DeleteNewSym();
OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@ -1969,10 +2121,11 @@ static void EnumPtrs(void (*P)(void*))
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
P(OPT_Links);
}
__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_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,
@ -2008,6 +2161,7 @@ __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32,
1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996,
2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, -2044}};
__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-4}};
__TDESC(OPT_LinkDesc, 1, 1) = {__TDFLDS("LinkDesc", 260), {256, -8}};
export void *OPT__init(void)
{
@ -2024,6 +2178,7 @@ export void *OPT__init(void)
__INITYP(OPT_NodeDesc, OPT_NodeDesc, 0);
__INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0);
__INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0);
__INITYP(OPT_LinkDesc, OPT_LinkDesc, 0);
/* BEGIN */
OPT_topScope = NIL;
OPT_OpenScope(0, NIL);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPT__h
@ -21,6 +21,15 @@ typedef
LONGREAL realval;
} OPT_ConstDesc;
typedef
struct OPT_LinkDesc *OPT_Link;
typedef
struct OPT_LinkDesc {
OPS_Name name;
OPT_Link next;
} OPT_LinkDesc;
typedef
struct OPT_NodeDesc *OPT_Node;
@ -52,6 +61,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -75,11 +85,13 @@ import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
import OPT_Link OPT_Links;
import ADDRESS *OPT_ConstDesc__typ;
import ADDRESS *OPT_ObjDesc__typ;
import ADDRESS *OPT_StrDesc__typ;
import ADDRESS *OPT_NodeDesc__typ;
import ADDRESS *OPT_LinkDesc__typ;
import void OPT_Align (INT32 *adr, INT32 base);
import INT32 OPT_BaseAlignment (OPT_Struct typ);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -112,7 +112,7 @@ static void OPV_Stamp (OPS_Name s)
i += 2;
k = 0;
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);
k += 1;
} while (!(j == 0));
@ -163,7 +163,7 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
}
scope = obj->scope;
scope->leaf = 1;
__COPY(obj->name, scope->name, 256);
__MOVE(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@ -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)
{
INT64 d;
OPT_Struct array = NIL;
while ((n->class == 4 && n->typ->comp == 3)) {
dim += 1;
n = n->left;
}
if ((n->class == 3 && n->typ->comp == 3)) {
d = dim;
array = n->typ;
while (d > 0) {
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 {
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_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 (from == 7) {
OPV_SizeCast(n, newtype->size);
OPV_Entier(n, 9);
} else {
OPM_WriteString((CHAR*)"__SETOF(", 9);
OPV_Entier(n, -1);
@ -391,7 +403,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec)
}
} else if (to == 4) {
OPV_SizeCast(n, newtype->size);
OPV_Entier(n, 9);
} else if (to == 3) {
if (__IN(2, OPM_Options, 32)) {
OPM_WriteString((CHAR*)"__CHR", 6);
@ -1183,7 +1194,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
base = base->BaseTyp;
}
if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) {
OPC_Ident(base->strobj);
OPC_Andent(base);
OPM_WriteString((CHAR*)"__typ", 6);
} else if (base->form == 11) {
OPM_WriteString((CHAR*)"POINTER__typ", 13);
@ -1286,7 +1297,17 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
} else if (r->typ->comp == 3) {
OPM_WriteString((CHAR*)"__X(", 5);
OPC_Len(r->obj, r->typ, 0);
OPM_WriteString((CHAR*)" * ", 4);
OPM_WriteInt(r->typ->BaseTyp->size);
OPM_WriteString((CHAR*)", ", 3);
OPM_WriteInt(l->typ->size + 1);
OPM_Write(')');
} else {
__ASSERT(r->typ->comp == 2, 0);
__ASSERT(r->typ->size <= l->typ->size, 0);
OPM_WriteInt(r->typ->size);
}
OPM_Write(')');

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPV__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -6,6 +6,7 @@
#define SET UINT32
#include "SYSTEM.h"
#include "Heap.h"
#include "Platform.h"
@ -16,17 +17,18 @@ static INT16 Out_in;
export void Out_Char (CHAR ch);
export void Out_Flush (void);
export void Out_Hex (INT64 x, INT64 n);
export void Out_Int (INT64 x, INT64 n);
static INT32 Out_Length (CHAR *s, LONGINT s__len);
static INT32 Out_Length (CHAR *s, ADDRESS s__len);
export void Out_Ln (void);
export void Out_LongReal (LONGREAL x, INT16 n);
export void Out_Open (void);
export void Out_Real (REAL x, INT16 n);
static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_);
export void Out_String (CHAR *str, LONGINT str__len);
export void Out_String (CHAR *str, ADDRESS str__len);
export LONGREAL Out_Ten (INT16 e);
static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i);
static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i);
#define Out_Entier64(x) (INT64)(x)
@ -55,7 +57,7 @@ void Out_Char (CHAR ch)
}
}
static INT32 Out_Length (CHAR *s, LONGINT s__len)
static INT32 Out_Length (CHAR *s, ADDRESS s__len)
{
INT32 l;
l = 0;
@ -65,7 +67,7 @@ static INT32 Out_Length (CHAR *s, LONGINT s__len)
return l;
}
void Out_String (CHAR *str, LONGINT str__len)
void Out_String (CHAR *str, ADDRESS str__len)
{
INT32 l;
INT16 error;
@ -78,7 +80,7 @@ void Out_String (CHAR *str, LONGINT str__len)
error = Platform_Write(1, (ADDRESS)str, l);
} else {
__MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l);
Out_in += (INT16)l;
Out_in += __SHORT(l, 32768);
}
__DEL(str);
}
@ -89,18 +91,18 @@ void Out_Int (INT64 x, INT64 n)
INT16 i;
BOOLEAN negative;
negative = x < 0;
if (x == (-9223372036854775807-1)) {
if (x == (-9223372036854775807LL-1)) {
__MOVE("8085774586302733229", s, 20);
i = 19;
} else {
if (x < 0) {
x = -x;
}
s[0] = (CHAR)(48 + __MOD(x, 10));
s[0] = __CHR(48 + __MOD(x, 10));
x = __DIV(x, 10);
i = 1;
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);
i += 1;
}
@ -119,19 +121,43 @@ void Out_Int (INT64 x, INT64 n)
}
}
void Out_Hex (INT64 x, INT64 n)
{
if (n < 1) {
n = 1;
} else if (n > 16) {
n = 16;
}
if (x >= 0) {
while ((n < 16 && __LSH(x, -__ASHL(n, 2), 64) != 0)) {
n += 1;
}
}
x = __ROT(x, __ASHL(16 - n, 2), 64);
while (n > 0) {
x = __ROTL(x, 4, 64);
n -= 1;
if (__MASK(x, -16) < 10) {
Out_Char(__CHR(__MASK(x, -16) + 48));
} else {
Out_Char(__CHR((__MASK(x, -16) - 10) + 65));
}
}
}
void Out_Ln (void)
{
Out_String(Platform_NL, 3);
Out_Flush();
}
static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i)
{
*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, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i)
{
INT16 j;
INT32 l;
@ -140,7 +166,7 @@ static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16
if (l > *i) {
l = *i;
}
*i -= (INT16)l;
*i -= __SHORT(l, 32768);
j = 0;
while (j < l) {
s[__X(*i + j, s__len)] = t[__X(j, t__len)];
@ -175,7 +201,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
INT64 m;
INT16 d, dr;
e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
f = __MASK((__VAL(INT64, x)), -4503599627370496);
f = __MASK((__VAL(INT64, x)), -4503599627370496LL);
nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
if (nn) {
n -= 1;
@ -222,7 +248,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
if (nn) {
x = -x;
}
e = (INT16)__ASHR((e - 1023) * 77, 8);
e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
if (e >= 0) {
x = x / (LONGREAL)Out_Ten(e);
} else {
@ -306,6 +332,7 @@ void Out_LongReal (LONGREAL x, INT16 n)
export void *Out__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Out", 0);
__REGCMD("Flush", Out_Flush);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Out__h
@ -11,12 +11,13 @@ import BOOLEAN Out_IsConsole;
import void Out_Char (CHAR ch);
import void Out_Flush (void);
import void Out_Hex (INT64 x, INT64 n);
import void Out_Int (INT64 x, INT64 n);
import void Out_Ln (void);
import void Out_LongReal (LONGREAL x, INT16 n);
import void Out_Open (void);
import void Out_Real (REAL x, INT16 n);
import void Out_String (CHAR *str, LONGINT str__len);
import void Out_String (CHAR *str, ADDRESS str__len);
import LONGREAL Out_Ten (INT16 e);
import void *Out__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -7,37 +7,18 @@
#include "SYSTEM.h"
typedef
CHAR (*Platform_ArgPtr)[1024];
typedef
Platform_ArgPtr (*Platform_ArgVec)[1024];
typedef
INT32 (*Platform_ArgVecPtr)[1];
typedef
CHAR (*Platform_EnvPtr)[1024];
typedef
struct Platform_FileIdentity {
INT32 volume, index, mtime;
} Platform_FileIdentity;
typedef
void (*Platform_HaltProcedure)(INT32);
typedef
void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
export INT32 Platform_MainStackFrame;
export INT16 Platform_PID;
export CHAR Platform_CWD[256];
export INT16 Platform_ArgCount;
export INT32 Platform_ArgVector;
static Platform_HaltProcedure Platform_HaltHandler;
static INT32 Platform_TimeStart;
export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
export CHAR Platform_NL[3];
@ -45,35 +26,33 @@ export CHAR Platform_NL[3];
export ADDRESS *Platform_FileIdentity__typ;
export BOOLEAN Platform_Absent (INT16 e);
export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
export INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
export INT16 Platform_Close (INT32 h);
export BOOLEAN Platform_ConnectionFailed (INT16 e);
export void Platform_Delay (INT32 ms);
export BOOLEAN Platform_DifferentFilesystems (INT16 e);
export INT16 Platform_Error (void);
export void Platform_Exit (INT32 code);
export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
export void Platform_GetClock (INT32 *t, INT32 *d);
export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
export void Platform_GetIntArg (INT16 n, INT32 *val);
export void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
export void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
export INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export BOOLEAN Platform_Inaccessible (INT16 e);
export void Platform_Init (INT32 argc, INT32 argvadr);
export BOOLEAN Platform_Interrupted (INT16 e);
export BOOLEAN Platform_IsConsole (INT32 h);
export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
export INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h);
export INT16 Platform_MaxNameLength (void);
export INT16 Platform_MaxPathLength (void);
export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
export BOOLEAN Platform_NoSuchDirectory (INT16 e);
export INT32 Platform_OSAllocate (INT32 size);
export void Platform_OSFree (INT32 address);
export INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
export INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
export INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
export INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
export INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
export INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
export INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
export INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
@ -83,16 +62,16 @@ export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__t
export void Platform_SetQuitHandler (Platform_SignalHandler handler);
export INT16 Platform_Size (INT32 h, INT32 *l);
export INT16 Platform_Sync (INT32 h);
export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
export INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
static void Platform_TestLittleEndian (void);
export INT32 Platform_Time (void);
export BOOLEAN Platform_TimedOut (INT16 e);
export BOOLEAN Platform_TooManyFiles (INT16 e);
export INT16 Platform_Truncate (INT32 h, INT32 l);
export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
export INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
export INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
static void Platform_YMDHMStoClock (INT32 ye, INT32 mo, INT32 da, INT32 ho, INT32 mi, INT32 se, INT32 *t, INT32 *d);
export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
#include <errno.h>
#include <errno.h>
@ -102,6 +81,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#include <sys/types.h>
#include <time.h>
#include <unistd.h>
#include <limits.h>
#include <stdio.h>
#include <stdlib.h>
#define Platform_EACCES() EACCES
@ -117,8 +97,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_EROFS() EROFS
#define Platform_ETIMEDOUT() ETIMEDOUT
#define Platform_EXDEV() EXDEV
extern void Heap_InitHeap();
#define Platform_HeapInitHeap() Heap_InitHeap()
#define Platform_NAMEMAX() NAME_MAX
#define Platform_PATHMAX() PATH_MAX
#define Platform_allocate(size) (ADDRESS)((void*)malloc((size_t)size))
#define Platform_chdir(n, n__len) chdir((char*)n)
#define Platform_closefile(fd) close(fd)
@ -129,7 +109,7 @@ extern void Heap_InitHeap();
#define Platform_fsync(fd) fsync(fd)
#define Platform_ftruncate(fd, l) ftruncate(fd, l)
#define Platform_getcwd(cwd, cwd__len) getcwd((char*)cwd, cwd__len)
#define Platform_getenv(var, var__len) (Platform_EnvPtr)getenv((char*)var)
#define Platform_getenv(var, var__len) getenv((char*)var)
#define Platform_getpid() (INTEGER)getpid()
#define Platform_gettimeval() struct timeval tv; gettimeofday(&tv,0)
#define Platform_isatty(fd) isatty(fd)
@ -203,6 +183,16 @@ BOOLEAN Platform_Interrupted (INT16 e)
return e == Platform_EINTR();
}
INT16 Platform_MaxNameLength (void)
{
return Platform_NAMEMAX();
}
INT16 Platform_MaxPathLength (void)
{
return Platform_PATHMAX();
}
INT32 Platform_OSAllocate (INT32 size)
{
return Platform_allocate(size);
@ -213,21 +203,14 @@ void Platform_OSFree (INT32 address)
Platform_free(address);
}
void Platform_Init (INT32 argc, INT32 argvadr)
{
Platform_ArgVecPtr av = NIL;
Platform_MainStackFrame = argvadr;
Platform_ArgCount = __VAL(INT16, argc);
av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
Platform_ArgVector = (*av)[0];
Platform_HeapInitHeap();
}
typedef
CHAR (*EnvPtr__83)[1024];
BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
Platform_EnvPtr p = NIL;
EnvPtr__83 p = NIL;
__DUP(var, var__len, CHAR);
p = Platform_getenv(var, var__len);
p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
if (p != NIL) {
__COPY(*p, val, val__len);
}
@ -235,7 +218,7 @@ BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__le
return p != NIL;
}
void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
@ -244,56 +227,6 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
{
Platform_ArgVec av = NIL;
if (n < Platform_ArgCount) {
av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
__COPY(*(*av)[__X(n, 1024)], val, val__len);
}
}
void Platform_GetIntArg (INT16 n, INT32 *val)
{
CHAR s[64];
INT32 k, d, i;
s[0] = 0x00;
Platform_GetArg(n, (void*)s, 64);
i = 0;
if (s[0] == '-') {
i = 1;
}
k = 0;
d = (INT16)s[__X(i, 64)] - 48;
while ((d >= 0 && d <= 9)) {
k = k * 10 + d;
i += 1;
d = (INT16)s[__X(i, 64)] - 48;
}
if (s[0] == '-') {
k = -k;
i -= 1;
}
if (i > 0) {
*val = k;
}
}
INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
{
INT16 i;
CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0;
Platform_GetArg(i, (void*)arg, 256);
while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1;
Platform_GetArg(i, (void*)arg, 256);
}
__DEL(s);
return i;
}
void Platform_SetInterruptHandler (Platform_SignalHandler handler)
{
Platform_sethandler(2, handler);
@ -345,7 +278,7 @@ void Platform_Delay (INT32 ms)
Platform_nanosleep(s, ns);
}
INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
{
__DUP(cmd, cmd__len, CHAR);
__DEL(cmd);
@ -357,7 +290,7 @@ INT16 Platform_Error (void)
return Platform_err();
}
INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openro(n, n__len);
@ -370,7 +303,7 @@ INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openrw(n, n__len);
@ -383,7 +316,7 @@ INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_opennew(n, n__len);
@ -423,7 +356,7 @@ INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *iden
return 0;
}
INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
__DUP(n, n__len, CHAR);
Platform_structstats();
@ -481,7 +414,7 @@ INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n)
__RETCHK;
}
INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n)
{
*n = Platform_readfile(h, (ADDRESS)b, b__len);
if (*n < 0) {
@ -535,7 +468,7 @@ INT16 Platform_Truncate (INT32 h, INT32 l)
__RETCHK;
}
INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
INT16 Platform_Unlink (CHAR *n, ADDRESS n__len)
{
if (Platform_unlink(n, n__len) < 0) {
return Platform_err();
@ -545,7 +478,7 @@ INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
__RETCHK;
}
INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
INT16 Platform_Chdir (CHAR *n, ADDRESS n__len)
{
INT16 r;
if ((Platform_chdir(n, n__len) >= 0 && Platform_getcwd((void*)Platform_CWD, 256) != NIL)) {
@ -556,7 +489,7 @@ INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
__RETCHK;
}
INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len)
{
if (Platform_rename(o, o__len, n, n__len) < 0) {
return Platform_err();
@ -587,7 +520,6 @@ export void *Platform__init(void)
__INITYP(Platform_FileIdentity, Platform_FileIdentity, 0);
/* BEGIN */
Platform_TestLittleEndian();
Platform_HaltHandler = NIL;
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
Platform_PID = Platform_getpid();

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Platform__h
@ -16,46 +16,41 @@ typedef
import BOOLEAN Platform_LittleEndian;
import INT32 Platform_MainStackFrame;
import INT16 Platform_PID;
import CHAR Platform_CWD[256];
import INT16 Platform_ArgCount;
import INT32 Platform_ArgVector;
import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
import CHAR Platform_NL[3];
import ADDRESS *Platform_FileIdentity__typ;
import BOOLEAN Platform_Absent (INT16 e);
import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
import INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
import INT16 Platform_Close (INT32 h);
import BOOLEAN Platform_ConnectionFailed (INT16 e);
import void Platform_Delay (INT32 ms);
import BOOLEAN Platform_DifferentFilesystems (INT16 e);
import INT16 Platform_Error (void);
import void Platform_Exit (INT32 code);
import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
import void Platform_GetClock (INT32 *t, INT32 *d);
import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
import void Platform_GetIntArg (INT16 n, INT32 *val);
import void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
import INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import BOOLEAN Platform_Inaccessible (INT16 e);
import void Platform_Init (INT32 argc, INT32 argvadr);
import BOOLEAN Platform_Interrupted (INT16 e);
import BOOLEAN Platform_IsConsole (INT32 h);
import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d);
import INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h);
import INT16 Platform_MaxNameLength (void);
import INT16 Platform_MaxPathLength (void);
import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
import BOOLEAN Platform_NoSuchDirectory (INT16 e);
import INT32 Platform_OSAllocate (INT32 size);
import void Platform_OSFree (INT32 address);
import INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
import INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
import INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
import INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
import INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
import INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
import INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
import INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
@ -65,14 +60,14 @@ import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__t
import void Platform_SetQuitHandler (Platform_SignalHandler handler);
import INT16 Platform_Size (INT32 h, INT32 *l);
import INT16 Platform_Sync (INT32 h);
import INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
import INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
import INT32 Platform_Time (void);
import BOOLEAN Platform_TimedOut (INT16 e);
import BOOLEAN Platform_TooManyFiles (INT16 e);
import INT16 Platform_Truncate (INT32 h, INT32 l);
import INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
import INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
import INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
import BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void *Platform__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -10,11 +10,11 @@
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
export void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
export void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len);
export void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
export void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
export void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
export INT16 Reals_Expo (REAL x);
export INT16 Reals_ExpoL (LONGREAL x);
export void Reals_SetExpo (REAL *x, INT16 ex);
@ -67,9 +67,9 @@ void Reals_SetExpo (REAL *x, INT16 ex)
{
CHAR c;
__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);
__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)
@ -79,7 +79,7 @@ INT16 Reals_ExpoL (LONGREAL x)
return __MASK(__ASHR(i, 4), -2048);
}
void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
INT32 i, j, k;
if (x < (LONGREAL)0) {
@ -87,27 +87,27 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
}
k = 0;
if (n > 9) {
i = (INT32)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000);
j = (INT32)__ENTIER(x - i * (LONGREAL)1000000000);
i = __SHORT(__ENTIER(x / (LONGREAL)(LONGREAL)1000000000), 2147483648LL);
j = __SHORT(__ENTIER(x - i * (LONGREAL)1000000000), 2147483648LL);
if (j < 0) {
j = 0;
}
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);
k += 1;
}
} else {
i = (INT32)__ENTIER(x);
i = __SHORT(__ENTIER(x), 2147483648LL);
}
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);
k += 1;
}
}
void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
@ -115,14 +115,14 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
static CHAR Reals_ToHex (INT16 i)
{
if (i < 10) {
return (CHAR)(i + 48);
return __CHR(i + 48);
} else {
return (CHAR)(i + 55);
return __CHR(i + 55);
}
__RETCHK;
}
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len)
{
INT16 i;
INT32 l;
@ -137,12 +137,12 @@ static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LO
}
}
void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Reals__h
@ -8,10 +8,10 @@
import void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
import void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
import void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
import void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
import void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
import INT16 Reals_Expo (REAL x);
import INT16 Reals_ExpoL (LONGREAL x);
import void Reals_SetExpo (REAL *x, INT16 ex);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -6,22 +6,25 @@
#define SET UINT32
#include "SYSTEM.h"
#include "Reals.h"
export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
export void Strings_Cap (CHAR *s, LONGINT s__len);
export void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
export void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
export void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
export INT16 Strings_Length (CHAR *s, LONGINT s__len);
export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
export INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
export void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
export void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
export void Strings_Cap (CHAR *s, ADDRESS s__len);
export void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
export void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
export void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
export INT16 Strings_Length (CHAR *s, ADDRESS s__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 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, LONGINT s__len)
INT16 Strings_Length (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
}
if (i <= 32767) {
__DEL(s);
return (INT16)i;
return __SHORT(i, 32768);
} else {
__DEL(s);
return 32767;
@ -39,7 +42,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
__RETCHK;
}
void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
@ -56,7 +59,7 @@ void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__
__DEL(extra);
}
void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
@ -87,7 +90,7 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, L
__DEL(source);
}
void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
{
INT16 len, i;
len = Strings_Length(s, s__len);
@ -110,7 +113,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
}
}
void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
__DUP(source, source__len, CHAR);
Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len));
@ -118,12 +121,12 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest,
__DEL(source);
}
void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len)
{
INT16 len, destLen, i;
__DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len);
destLen = (INT16)dest__len - 1;
destLen = __SHORT(dest__len, 32768) - 1;
if (pos < 0) {
pos = 0;
}
@ -143,7 +146,7 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHA
__DEL(source);
}
INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos)
{
INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
@ -175,7 +178,7 @@ INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len,
return -1;
}
void Strings_Cap (CHAR *s, LONGINT s__len)
void Strings_Cap (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@ -191,9 +194,9 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m);
static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m)
{
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
@ -220,7 +223,7 @@ static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__le
return 0;
}
BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len)
{
struct Match__7 _s;
BOOLEAN __retval;
@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT
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)
{
__DEFMOD;
__MODULE_IMPORT(Reals);
__REGMOD("Strings", 0);
/* BEGIN */
__ENDMOD;

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Strings__h
@ -8,15 +8,17 @@
import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
import void Strings_Cap (CHAR *s, LONGINT s__len);
import void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
import void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
import void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
import INT16 Strings_Length (CHAR *s, LONGINT s__len);
import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
import INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
import void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
import void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
import void Strings_Cap (CHAR *s, ADDRESS s__len);
import void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
import void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
import void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
import INT16 Strings_Length (CHAR *s, ADDRESS s__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 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);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -187,20 +187,20 @@ export void Texts_Append (Texts_Text T, Texts_Buffer B);
export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
export INT32 Texts_ElemPos (Texts_Elem E);
static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len);
static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_OpenBuf (Texts_Buffer B);
export void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
export void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@ -229,10 +229,10 @@ export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len)
{
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
@ -390,27 +390,27 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__t
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
Texts_CopyMsg *msg__ = (void*)msg;
__NEW(e, Texts__1);
Texts_CopyElem((void*)((Texts_Alien)E), (void*)e);
e->file = ((Texts_Alien)E)->file;
e->org = ((Texts_Alien)E)->org;
e->span = ((Texts_Alien)E)->span;
__COPY(((Texts_Alien)E)->mod, e->mod, 32);
__COPY(((Texts_Alien)E)->proc, e->proc, 32);
Texts_CopyElem((void*)(*(Texts_Alien*)&E), (void*)e);
e->file = (*(Texts_Alien*)&E)->file;
e->org = (*(Texts_Alien*)&E)->org;
e->span = (*(Texts_Alien*)&E)->span;
__MOVE((*(Texts_Alien*)&E)->mod, e->mod, 32);
__MOVE((*(Texts_Alien*)&E)->proc, e->proc, 32);
(*msg__).e = (Texts_Elem)e;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
Texts_IdentifyMsg *msg__ = (void*)msg;
__COPY(((Texts_Alien)E)->mod, (*msg__).mod, 32);
__COPY(((Texts_Alien)E)->proc, (*msg__).proc, 32);
__COPY((*(Texts_Alien*)&E)->mod, (*msg__).mod, 32);
__COPY((*(Texts_Alien*)&E)->proc, (*msg__).proc, 32);
(*msg__).mod[31] = 0x01;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_FileMsg, 1)) {
if (__IS(msg__typ, Texts_FileMsg, 1)) {
Texts_FileMsg *msg__ = (void*)msg;
if ((*msg__).id == 1) {
Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org);
i = ((Texts_Alien)E)->span;
Files_Set(&r, Files_Rider__typ, (*(Texts_Alien*)&E)->file, (*(Texts_Alien*)&E)->org);
i = (*(Texts_Alien*)&E)->span;
while (i > 0) {
Files_Read(&r, Files_Rider__typ, (void*)&ch);
Files_Write(&(*msg__).r, Files_Rider__typ, ch);
@ -646,7 +646,7 @@ void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
u = u->next;
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
} else __WITHCHK;
}
(*R).run = u;
@ -673,7 +673,7 @@ void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
(*R).elem = __GUARDP(u, Texts_ElemDesc, 1);
if (__ISP(un, Texts_PieceDesc, 1)) {
if (__ISP(un, Texts_PieceDesc, 1)) {
Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org);
Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&un)->file, (*(Texts_Piece*)&un)->org);
} else __WITHCHK;
}
} else {
@ -812,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ)
if ('9' < ch) {
if (('A' <= ch && ch <= 'F')) {
hex = 1;
ch = (CHAR)((INT16)ch - 7);
ch = __CHR((INT16)ch - 7);
} else if (('a' <= ch && ch <= 'f')) {
hex = 1;
ch = (CHAR)((INT16)ch - 39);
ch = __CHR((INT16)ch - 39);
} else {
break;
}
@ -1027,7 +1027,7 @@ void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
Texts_Write(&*W, W__typ, 0x0d);
}
void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@ -1046,7 +1046,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
CHAR a[24];
i = 0;
if (x < 0) {
if (x == (-9223372036854775807-1)) {
if (x == (-9223372036854775807LL-1)) {
Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
@ -1057,7 +1057,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
x0 = x;
}
do {
a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48);
a[__X(i, 24)] = __CHR(__MOD(x0, 10) + 48);
x0 = __DIV(x0, 10);
i += 1;
} while (!(x0 == 0));
@ -1084,9 +1084,9 @@ void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x)
do {
y = __MASK(x, -16);
if (y < 10) {
a[__X(i, 20)] = (CHAR)(y + 48);
a[__X(i, 20)] = __CHR(y + 48);
} else {
a[__X(i, 20)] = (CHAR)(y + 55);
a[__X(i, 20)] = __CHR(y + 55);
}
x = __ASHR(x, 4);
i += 1;
@ -1162,8 +1162,8 @@ void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n)
} else {
Texts_Write(&*W, W__typ, '+');
}
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
}
}
@ -1313,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
} else {
Texts_Write(&*W, W__typ, ' ');
}
e = (INT16)__ASHR((e - 1023) * 77, 8);
e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
if (e >= 0) {
x = x / (LONGREAL)Reals_TenL(e);
} else {
@ -1344,10 +1344,10 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n)
} else {
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);
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
}
}
@ -1374,8 +1374,8 @@ 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, (CHAR)(__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(__DIV(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)
@ -1406,8 +1406,8 @@ static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span
static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
Modules_Module M = NIL;
Modules_Command Cmd;
Heap_Module M = NIL;
Heap_Command Cmd;
Texts_Alien a = NIL;
INT32 org, ew, eh;
INT8 eno;
@ -1539,7 +1539,7 @@ void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Texts_Load0(&*r, r__typ, T);
}
void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
@ -1715,9 +1715,9 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
while (u != T->head) {
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
if (((Texts_Piece)u)->ascii) {
Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
delta = ((Texts_Piece)u)->len;
if ((*(Texts_Piece*)&u)->ascii) {
Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
delta = (*(Texts_Piece*)&u)->len;
while (delta > 0) {
Files_Read(&r1, Files_Rider__typ, (void*)&ch);
delta -= 1;
@ -1728,8 +1728,8 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
}
}
} else {
Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
delta = ((Texts_Piece)u)->len;
Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
delta = (*(Texts_Piece*)&u)->len;
while (delta > 1024) {
Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
@ -1755,7 +1755,7 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Store__39_s = _s.lnk;
}
void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Texts__h
@ -131,7 +131,7 @@ import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
@ -139,7 +139,7 @@ import Texts_Text Texts_ElemBase (Texts_Elem E);
import INT32 Texts_ElemPos (Texts_Elem E);
import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_OpenBuf (Texts_Buffer B);
import void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
import void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@ -166,7 +166,7 @@ import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
import void *Texts__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -27,23 +27,24 @@ export void VT100_DECTCEMl (void);
export void VT100_DSR (INT16 n);
export void VT100_ED (INT16 n);
export void VT100_EL (INT16 n);
static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len);
static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len);
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len);
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len);
export void VT100_HVP (INT16 n, INT16 m);
export void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
export void VT100_RCP (void);
static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end);
export void VT100_Reset (void);
static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end);
export void VT100_SCP (void);
export void VT100_SD (INT16 n);
export void VT100_SGR (INT16 n);
export void VT100_SGR2 (INT16 n, INT16 m);
export void VT100_SU (INT16 n);
export void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
export void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end)
{
CHAR h;
while (start < end) {
@ -55,7 +56,7 @@ static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
}
}
void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
{
CHAR b[21];
INT16 s, e;
@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
}
e = s;
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);
e += 1;
} while (!(int_ == 0));
@ -84,7 +85,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
__COPY(b, str, str__len);
}
static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
{
CHAR cmd[9];
__DUP(letter, letter__len, CHAR);
@ -94,7 +95,7 @@ static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@ -107,7 +108,7 @@ static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@ -120,7 +121,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[5], mstr[5];
CHAR cmd[12];
@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
__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)
{
VT100_EscSeq(n, (CHAR*)"A", 2);
@ -236,7 +246,7 @@ void VT100_DECTCEMh (void)
VT100_EscSeq0((CHAR*)"\?25h", 5);
}
void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
void VT100_SetAttr (CHAR *attr, ADDRESS attr__len)
{
CHAR tmpstr[16];
__DUP(attr, attr__len, CHAR);
@ -256,6 +266,7 @@ export void *VT100__init(void)
__REGCMD("DECTCEMh", VT100_DECTCEMh);
__REGCMD("DECTCEMl", VT100_DECTCEMl);
__REGCMD("RCP", VT100_RCP);
__REGCMD("Reset", VT100_Reset);
__REGCMD("SCP", VT100_SCP);
/* BEGIN */
__COPY("\033", VT100_CSI, 5);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define VT100__h
@ -23,14 +23,15 @@ import void VT100_DSR (INT16 n);
import void VT100_ED (INT16 n);
import void VT100_EL (INT16 n);
import void VT100_HVP (INT16 n, INT16 m);
import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
import void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
import void VT100_RCP (void);
import void VT100_Reset (void);
import void VT100_SCP (void);
import void VT100_SD (INT16 n);
import void VT100_SGR (INT16 n);
import void VT100_SGR2 (INT16 n, INT16 m);
import void VT100_SU (INT16 n);
import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
import void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
import void *VT100__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -7,33 +7,40 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Heap.h"
#include "Modules.h"
#include "OPM.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
static CHAR extTools_CFLAGS[1023];
typedef
CHAR extTools_CommandString[4096];
export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
static extTools_CommandString extTools_CFLAGS;
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__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);
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;
extTools_CommandString fullcmd;
__DUP(title, title__len, CHAR);
__DUP(cmd, cmd__len, CHAR);
if (__IN(18, OPM_Options, 32)) {
Out_String(title, title__len);
Out_String((CHAR*)" ", 3);
Out_String(cmd, cmd__len);
Out_Ln();
}
r = Platform_System(cmd, cmd__len);
__COPY(cmd, fullcmd, 4096);
Heap_GC(0);
r = Platform_System(fullcmd, 4096);
status = __MASK(r, -128);
exitcode = __ASHR(r, 8);
if (exitcode > 127) {
@ -63,50 +70,55 @@ static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGIN
__DEL(cmd);
}
static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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(OPM_ResourceDir, 1024, (void*)s, s__len);
Strings_Append((CHAR*)"/include\" ", 11, (void*)s, s__len);
Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 1023);
Strings_Append(extTools_CFLAGS, 1023, (void*)s, s__len);
Strings_Append(additionalopts, additionalopts__len, (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, LONGINT moduleName__len)
void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len)
{
CHAR cmd[1023];
extTools_CommandString cmd;
__DUP(moduleName, moduleName__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 1023);
Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 1023);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023);
Strings_Append((CHAR*)".c", 3, (void*)cmd, 1023);
extTools_execute((CHAR*)"Assemble: ", 11, cmd, 1023);
extTools_InitialiseCompilerCommand((void*)cmd, 4096, (CHAR*)"", 1);
Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096);
extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096);
__DEL(moduleName);
}
void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT 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);
extTools_InitialiseCompilerCommand((void*)cmd, 1023);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023);
Strings_Append((CHAR*)".c ", 4, (void*)cmd, 1023);
Strings_Append(additionalopts, additionalopts__len, (void*)cmd, 1023);
extTools_InitialiseCompilerCommand((void*)cmd, 4096, additionalopts, additionalopts__len);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096);
if (statically) {
Strings_Append((CHAR*)"-static", 8, (void*)cmd, 1023);
Strings_Append((CHAR*)" -static", 9, (void*)cmd, 4096);
}
Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 1023);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023);
Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 1023);
Strings_Append((CHAR*)"", 1, (void*)cmd, 1023);
Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 1023);
Strings_Append((CHAR*)" -l voc", 8, (void*)cmd, 1023);
Strings_Append((CHAR*)"-O", 3, (void*)cmd, 1023);
Strings_Append(OPM_Model, 10, (void*)cmd, 1023);
Strings_Append((CHAR*)"", 1, (void*)cmd, 1023);
extTools_execute((CHAR*)"Assemble and link: ", 20, cmd, 1023);
Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 4096);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
if (!statically || 1) {
Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 4096);
Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 4096);
Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 4096);
Strings_Append((CHAR*)" -lvoc", 7, (void*)cmd, 4096);
Strings_Append((CHAR*)"-O", 3, (void*)cmd, 4096);
Strings_Append(OPM_Model, 10, (void*)cmd, 4096);
Strings_Append((CHAR*)"", 1, (void*)cmd, 4096);
}
extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096);
__DEL(additionalopts);
}
@ -115,6 +127,7 @@ export void *extTools__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Modules);
__MODULE_IMPORT(OPM);
__MODULE_IMPORT(Out);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define extTools__h
@ -8,8 +8,8 @@
import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
import void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len);
import void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len);
import void *extTools__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -20,9 +20,9 @@
#include "extTools.h"
static CHAR Compiler_mname[256];
static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len);
export void Compiler_Module (BOOLEAN *done);
static void Compiler_PropagateElementaryTypeSizes (void);
export void Compiler_Translate (void);
@ -41,11 +41,12 @@ void Compiler_Module (BOOLEAN *done)
OPT_Export(&ext, &new);
if (OPM_noerr) {
OPM_OpenFiles((void*)OPT_SelfName, 256);
OPM_DeleteObj((void*)OPT_SelfName, 256);
OPC_Init();
OPV_Module(p);
if (OPM_noerr) {
if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
OPM_DeleteNewSym();
OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogWStr((CHAR*)" Main program.", 16);
OPM_LogVT100((CHAR*)"0m", 3);
@ -61,7 +62,7 @@ void Compiler_Module (BOOLEAN *done)
}
}
} else {
OPM_DeleteNewSym();
OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@ -88,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp;
switch (OPM_LongintSize) {
switch (OPM_SetSize) {
case 4:
OPT_settyp = OPT_set32typ;
break;
@ -104,14 +105,44 @@ static void Compiler_PropagateElementaryTypeSizes (void)
}
}
static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len)
{
OPT_Link l = NIL;
CHAR fn[64];
Platform_FileIdentity id;
objectnames[0] = 0x00;
l = OPT_Links;
while (l != NIL) {
__COPY(l->name, fn, 64);
Strings_Append((CHAR*)".sym", 5, (void*)fn, 64);
if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
__COPY(l->name, fn, 64);
Strings_Append((CHAR*)".o", 3, (void*)fn, 64);
if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
Strings_Append((CHAR*)" ", 2, (void*)objectnames, objectnames__len);
Strings_Append(fn, 64, (void*)objectnames, objectnames__len);
} else {
OPM_LogVT100((CHAR*)"91m", 4);
OPM_LogWStr((CHAR*)"Link warning: a local symbol file is present for module ", 57);
OPM_LogWStr(l->name, 256);
OPM_LogWStr((CHAR*)", but local object file '", 26);
OPM_LogWStr(fn, 64);
OPM_LogWStr((CHAR*)"' is missing.", 14);
OPM_LogVT100((CHAR*)"0m", 3);
OPM_LogWLn();
}
}
l = l->next;
}
}
void Compiler_Translate (void)
{
BOOLEAN done;
CHAR modulesobj[2048];
modulesobj[0] = 0x00;
CHAR linkfiles[2048];
if (OPM_OpenPar()) {
for (;;) {
OPM_Init(&done, (void*)Compiler_mname, 256);
OPM_Init(&done);
if (!done) {
return;
}
@ -131,11 +162,9 @@ void Compiler_Translate (void)
} else {
if (!__IN(10, OPM_Options, 32)) {
extTools_Assemble(OPM_modName, 32);
Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
} else {
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
}
}
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -8,7 +8,7 @@
#include "SYSTEM.h"
export CHAR Configuration_versionLong[75];
export CHAR Configuration_versionLong[76];
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
__MOVE("1.95 [2016/11/24]. 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;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Configuration__h
@ -6,7 +6,7 @@
#include "SYSTEM.h"
import CHAR Configuration_versionLong[75];
import CHAR Configuration_versionLong[76];
import void *Configuration__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -26,7 +26,7 @@ typedef
Files_BufDesc *Files_Buffer;
typedef
CHAR Files_FileName[101];
CHAR Files_FileName[256];
typedef
struct Files_FileDesc {
@ -36,7 +36,7 @@ typedef
INT32 fd, len, pos;
Files_Buffer bufs[4];
INT16 swapper, state;
Files_File next;
struct Files_FileDesc *next;
} Files_FileDesc;
typedef
@ -48,11 +48,12 @@ typedef
} Files_Rider;
static Files_File Files_files;
export INT16 Files_MaxPathLength, Files_MaxNameLength;
static Files_FileDesc *Files_files;
static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
LONGINT len[1];
ADDRESS len[1];
CHAR data[1];
} *Files_SearchPath;
@ -60,58 +61,68 @@ export ADDRESS *Files_FileDesc__typ;
export ADDRESS *Files_BufDesc__typ;
export ADDRESS *Files_Rider__typ;
static void Files_Assert (BOOLEAN truth);
export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
export void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
export void Files_Close (Files_File f);
static void Files_CloseOSFile (Files_File f);
static void Files_Create (Files_File f);
export void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode);
export void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
static void Files_Deregister (CHAR *name, ADDRESS name__len);
static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode);
static void Files_Finalize (SYSTEM_PTR o);
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len);
static void Files_Flush (Files_Buffer buf);
export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
export void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len);
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len);
export INT32 Files_Length (Files_File f);
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
export Files_File Files_New (CHAR *name, LONGINT name__len);
export Files_File Files_Old (CHAR *name, LONGINT name__len);
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len);
export Files_File Files_New (CHAR *name, ADDRESS name__len);
export Files_File Files_Old (CHAR *name, ADDRESS name__len);
export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
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_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
export void Files_Register (Files_File f);
export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len);
export void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len);
export void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
export void Files_SetSearchPath (CHAR *path, LONGINT path__len);
export void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
#define Files_IdxTrap() __HALT(-1)
#define Files_ToAdr(x) (ADDRESS)x
static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
static void Files_Assert (BOOLEAN truth)
{
if (!truth) {
Out_Ln();
__ASSERT(truth, 0);
}
}
static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
Out_Ln();
@ -120,17 +131,17 @@ static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
Out_String((CHAR*)": ", 3);
if (f != NIL) {
if (f->registerName[0] != 0x00) {
Out_String(f->registerName, 101);
Out_String(f->registerName, 256);
} else {
Out_String(f->workName, 101);
Out_String(f->workName, 256);
}
if (f->fd != 0) {
Out_String((CHAR*)"f.fd = ", 8);
Out_String((CHAR*)", f.fd = ", 10);
Out_Int(f->fd, 1);
}
}
if (errcode != 0) {
Out_String((CHAR*)" errcode = ", 12);
Out_String((CHAR*)", errcode = ", 13);
Out_Int(errcode, 1);
}
Out_Ln();
@ -138,98 +149,125 @@ static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
__DEL(s);
}
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT 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(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;
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;
while (dir[i] != 0x00) {
dest[i] = dir[i];
i += 1;
}
if (dest[i - 1] != '/') {
dest[i] = '/';
i += 1;
}
while (name[j] != 0x00) {
dest[i] = name[j];
while (j < ln) {
dest[__X(i, dest__len)] = name[__X(j, name__len)];
i += 1;
j += 1;
}
dest[i] = 0x00;
dest[__X(i, dest__len)] = 0x00;
__DEL(dir);
__DEL(name);
}
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT 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);
if (finalName[0] == '/') {
__COPY(finalName, name, name__len);
} else {
Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len);
}
i = Strings_Length(name, name__len) - 1;
while ((i > 0 && name[__X(i, name__len)] != '/')) {
i -= 1;
}
if ((i + 16) >= name__len) {
Files_Err((CHAR*)"File name too long", 19, NIL, 0);
}
Files_tempno += 1;
n = Files_tempno;
i = 0;
if (finalName[0] != '/') {
while (Platform_CWD[i] != 0x00) {
name[i] = Platform_CWD[i];
i += 1;
}
if (Platform_CWD[i - 1] != '/') {
name[i] = '/';
i += 1;
}
}
j = 0;
while (finalName[j] != 0x00) {
name[i] = finalName[j];
i += 1;
j += 1;
}
i -= 1;
while (name[i] != '/') {
i -= 1;
}
name[i + 1] = '.';
name[i + 2] = 't';
name[i + 3] = 'm';
name[i + 4] = 'p';
name[i + 5] = '.';
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;
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);
i += 1;
}
name[i] = '.';
name[__X(i, name__len)] = '.';
i += 1;
n = Platform_PID;
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);
i += 1;
}
name[i] = 0x00;
name[__X(i, name__len)] = 0x00;
__DEL(finalName);
}
static void Files_Deregister (CHAR *name, ADDRESS name__len)
{
Platform_FileIdentity identity;
Files_File osfile = NIL;
INT16 error;
__DUP(name, name__len, CHAR);
if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) {
osfile = (Files_File)Files_files;
while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) {
osfile = (Files_File)osfile->next;
}
if (osfile != NIL) {
__ASSERT(!osfile->tempFile, 0);
__ASSERT(osfile->fd >= 0, 0);
__MOVE(osfile->workName, osfile->registerName, 256);
Files_GetTempName(osfile->registerName, 256, (void*)osfile->workName, 256);
osfile->tempFile = 1;
osfile->state = 0;
error = Platform_Rename((void*)osfile->registerName, 256, (void*)osfile->workName, 256);
if (error != 0) {
Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error);
}
}
}
__DEL(name);
}
static void Files_Create (Files_File f)
{
Platform_FileIdentity identity;
BOOLEAN done;
INT16 error;
CHAR err[32];
if (f->fd == -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;
} else if (f->state == 2) {
__COPY(f->registerName, f->workName, 101);
} else {
__ASSERT(f->state == 2, 0);
Files_Deregister(f->registerName, 256);
__MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
error = Platform_Unlink((void*)f->workName, 101);
error = Platform_New((void*)f->workName, 101, &f->fd);
error = Platform_Unlink((void*)f->workName, 256);
error = Platform_New((void*)f->workName, 256, &f->fd);
done = error == 0;
if (done) {
f->next = Files_files;
@ -275,27 +313,6 @@ static void Files_Flush (Files_Buffer buf)
}
}
static void Files_CloseOSFile (Files_File f)
{
Files_File prev = NIL;
INT16 error;
if (Files_files == f) {
Files_files = f->next;
} else {
prev = Files_files;
while ((prev != NIL && prev->next != f)) {
prev = prev->next;
}
if (prev->next != NIL) {
prev->next = f->next;
}
}
error = Platform_Close(f->fd);
f->fd = -1;
f->state = 1;
Heap_FileCount -= 1;
}
void Files_Close (Files_File f)
{
INT32 i;
@ -303,11 +320,10 @@ void Files_Close (Files_File f)
if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f);
i = 0;
while ((i < 4 && f->bufs[i] != NIL)) {
Files_Flush(f->bufs[i]);
while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) {
Files_Flush(f->bufs[__X(i, 4)]);
i += 1;
}
Files_CloseOSFile(f);
}
}
@ -316,13 +332,13 @@ INT32 Files_Length (Files_File f)
return f->len;
}
Files_File Files_New (CHAR *name, LONGINT name__len)
Files_File Files_New (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc);
f->workName[0] = 0x00;
__COPY(name, f->registerName, 101);
__COPY(name, f->registerName, 256);
f->fd = -1;
f->state = 1;
f->len = 0;
@ -332,7 +348,7 @@ Files_File Files_New (CHAR *name, LONGINT name__len)
return f;
}
static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
{
INT16 i;
CHAR ch;
@ -344,38 +360,38 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
*pos += 1;
}
} else {
ch = (Files_SearchPath->data)[*pos];
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (ch == ' ' || ch == ';') {
*pos += 1;
ch = (Files_SearchPath->data)[*pos];
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
}
if (ch == '~') {
*pos += 1;
ch = (Files_SearchPath->data)[*pos];
while (Files_HOME[i] != 0x00) {
dir[i] = Files_HOME[i];
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
while (Files_HOME[__X(i, 1024)] != 0x00) {
dir[__X(i, dir__len)] = Files_HOME[__X(i, 1024)];
i += 1;
}
if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) {
while ((i > 0 && dir[i - 1] != '/')) {
while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) {
i -= 1;
}
}
}
while ((ch != 0x00 && ch != ';')) {
dir[i] = ch;
dir[__X(i, dir__len)] = ch;
i += 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;
}
}
dir[i] = 0x00;
dir[__X(i, dir__len)] = 0x00;
}
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -383,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
ch = name[0];
while ((ch != 0x00 && ch != '/')) {
i += 1;
ch = name[i];
ch = name[__X(i, name__len)];
}
return ch == '/';
}
@ -392,15 +408,15 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
Files_File f = NIL;
INT16 i, error;
f = Files_files;
f = (Files_File)Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
if (!Platform_SameFileTime(identity, f->identity)) {
i = 0;
while (i < 4) {
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
}
i += 1;
}
@ -410,12 +426,12 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
}
return f;
}
f = f->next;
f = (Files_File)f->next;
}
return NIL;
}
Files_File Files_Old (CHAR *name, LONGINT name__len)
Files_File Files_Old (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
INT32 fd;
@ -456,6 +472,7 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
error = Platform_Close(fd);
__DEL(name);
return f;
} else {
@ -466,7 +483,7 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
f->pos = 0;
f->swapper = -1;
error = Platform_Size(fd, &f->len);
__COPY(name, f->workName, 101);
__COPY(name, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
f->identity = identity;
@ -498,9 +515,9 @@ void Files_Purge (Files_File f)
INT16 error;
i = 0;
while (i < 4) {
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
}
i += 1;
}
@ -526,7 +543,7 @@ void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
__ASSERT((*r).offset <= 4096, 0);
Files_Assert((*r).offset <= 4096);
return (*r).org + (*r).offset;
}
@ -544,22 +561,22 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
offset = __MASK(pos, -4096);
org = pos - offset;
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;
}
if (i < 4) {
if (f->bufs[i] == NIL) {
if (f->bufs[__X(i, 4)] == NIL) {
__NEW(buf, Files_BufDesc);
buf->chg = 0;
buf->org = -1;
buf->f = f;
f->bufs[i] = buf;
f->bufs[__X(i, 4)] = buf;
} else {
buf = f->bufs[i];
buf = f->bufs[__X(i, 4)];
}
} else {
f->swapper = __MASK(f->swapper + 1, -4);
buf = f->bufs[f->swapper];
buf = f->bufs[__X(f->swapper, 4)];
Files_Flush(buf);
}
if (buf->org != org) {
@ -585,7 +602,7 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
org = 0;
offset = 0;
}
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@ -604,9 +621,9 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
__ASSERT(offset <= buf->size, 0);
Files_Assert(offset <= buf->size);
if (offset < buf->size) {
*x = buf->data[offset];
*x = buf->data[__X(offset, 4096)];
(*r).offset = offset + 1;
} else if ((*r).org + offset < buf->f->len) {
Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset);
@ -618,7 +635,12 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
}
}
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
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)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -644,12 +666,12 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
__MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
__MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
}
(*r).res = 0;
(*r).eof = 0;
@ -666,14 +688,14 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
__ASSERT(offset < 4096, 0);
buf->data[offset] = x;
Files_Assert(offset < 4096);
buf->data[__X(offset, 4096)] = x;
buf->chg = 1;
if (offset == buf->size) {
buf->size += 1;
@ -683,7 +705,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -694,23 +716,23 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
__MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
__MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
offset += min;
(*r).offset = offset;
__ASSERT(offset <= 4096, 0);
Files_Assert(offset <= 4096);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@ -722,14 +744,15 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
Files_Deregister(name, name__len);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res)
{
INT32 fdold, fdnew, n;
INT16 error, ignore;
@ -795,31 +818,30 @@ void Files_Register (Files_File f)
{
INT16 idx, errcode;
Files_File f1 = NIL;
CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
f->state = 2;
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
Files_Deregister(f->registerName, 256);
Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
if (errcode != 0) {
__COPY(f->registerName, file, 104);
__HALT(99);
Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
}
__COPY(f->registerName, f->workName, 101);
__MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
__DEL(path);
}
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len)
{
INT32 i, j;
if (!Platform_LittleEndian) {
@ -827,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *de
j = 0;
while (i > 0) {
i -= 1;
dest[j] = src[i];
dest[__X(j, dest__len)] = src[__X(i, src__len)];
j += 1;
}
} else {
@ -877,36 +899,36 @@ void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
CHAR ch;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&ch);
x[i] = ch;
x[__X(i, x__len)] = ch;
i += 1;
} while (!(ch == 0x00));
}
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&x[i]);
Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]);
i += 1;
} while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a));
if (x[i - 1] == 0x0a) {
} while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a));
if (x[__X(i - 1, x__len)] == 0x0a) {
i -= 1;
}
if ((i > 0 && x[i - 1] == 0x0d)) {
if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) {
i -= 1;
}
x[i] = 0x00;
x[__X(i, x__len)] = 0x00;
}
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len)
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
{
INT8 s, b;
INT64 q;
@ -919,7 +941,7 @@ void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__
Files_Read(&*R, R__typ, (void*)&b);
}
q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
__ASSERT(x__len <= 8, 0);
Files_Assert(x__len <= 8);
__MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
}
@ -931,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)
{
CHAR b[2];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[0] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2);
}
void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x)
{
CHAR b[4];
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[2] = (CHAR)__ASHR(x, 16);
b[3] = (CHAR)__ASHR(x, 24);
b[0] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
b[2] = __CHR(__ASHR(x, 16));
b[3] = __CHR(__ASHR(x, 24));
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
@ -950,11 +972,13 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{
CHAR b[4];
INT32 i;
i = (INT32)x;
b[0] = (CHAR)i;
b[1] = (CHAR)__ASHR(i, 8);
b[2] = (CHAR)__ASHR(i, 16);
b[3] = (CHAR)__ASHR(i, 24);
UINT64 y;
y = x;
i = __VAL(INT32, y);
b[0] = __CHR(i);
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);
}
@ -972,11 +996,11 @@ void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
i = 0;
while (x[i] != 0x00) {
while (x[__X(i, x__len)] != 0x00) {
i += 1;
}
Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
@ -985,17 +1009,38 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len
void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{
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);
}
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, LONGINT name__len)
void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
{
__COPY(f->workName, name, name__len);
}
static void Files_CloseOSFile (Files_File f)
{
Files_File prev = NIL;
INT16 error;
if (Files_files == (void *) f) {
Files_files = f->next;
} else {
prev = (Files_File)Files_files;
while ((prev != NIL && prev->next != (void *) f)) {
prev = (Files_File)prev->next;
}
if (prev->next != NIL) {
prev->next = f->next;
}
}
error = Platform_Close(f->fd);
f->fd = -1;
f->state = 1;
Heap_FileCount -= 1;
}
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
@ -1004,12 +1049,12 @@ static void Files_Finalize (SYSTEM_PTR o)
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {
res = Platform_Unlink((void*)f->workName, 101);
res = Platform_Unlink((void*)f->workName, 256);
}
}
}
void Files_SetSearchPath (CHAR *path, LONGINT path__len)
void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
@ -1023,11 +1068,10 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
static void EnumPtrs(void (*P)(void*))
{
P(Files_files);
P(Files_SearchPath);
}
__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 280), {232, 240, 248, 256, 272, -48}};
__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_Rider, 1, 1) = {__TDFLDS("Rider", 24), {8, -16}};
@ -1047,5 +1091,7 @@ export void *Files__init(void)
Heap_FileCount = 0;
Files_HOME[0] = 0x00;
Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024);
Files_MaxPathLength = Platform_MaxPathLength();
Files_MaxNameLength = Platform_MaxNameLength();
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define Files__h
@ -11,9 +11,7 @@ typedef
typedef
struct Files_FileDesc {
INT64 _prvt0;
char _prvt1[208];
INT32 fd;
char _prvt2[60];
char _prvt1[584];
} Files_FileDesc;
typedef
@ -25,46 +23,48 @@ typedef
} Files_Rider;
import INT16 Files_MaxPathLength, Files_MaxNameLength;
import ADDRESS *Files_FileDesc__typ;
import ADDRESS *Files_Rider__typ;
import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
import void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
import void Files_Close (Files_File f);
import void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
import void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
import void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
import void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
import INT32 Files_Length (Files_File f);
import Files_File Files_New (CHAR *name, LONGINT name__len);
import Files_File Files_Old (CHAR *name, LONGINT name__len);
import Files_File Files_New (CHAR *name, ADDRESS name__len);
import Files_File Files_Old (CHAR *name, ADDRESS name__len);
import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
import void Files_Purge (Files_File f);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
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_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x);
import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x);
import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void Files_Register (Files_File f);
import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
import void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
import void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
import void Files_SetSearchPath (CHAR *path, LONGINT path__len);
import void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void *Files__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -68,8 +68,10 @@ static INT64 Heap_freeList[10];
static INT64 Heap_bigBlocks;
export INT64 Heap_allocated;
static BOOLEAN Heap_firstTry;
static INT64 Heap_heap, Heap_heapend;
export INT64 Heap_heapsize;
static INT16 Heap_ldUnit;
export INT64 Heap_heap;
static INT64 Heap_heapMin, Heap_heapMax;
export INT64 Heap_heapsize, Heap_heapMinExpand;
static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
@ -84,15 +86,16 @@ static void Heap_CheckFin (void);
static void Heap_ExtendHeap (INT64 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
export INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
export void Heap_GC (BOOLEAN markStack);
static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len);
static void Heap_HeapSort (INT32 n, INT64 *a, ADDRESS a__len);
export void Heap_INCREF (Heap_Module m);
export void Heap_InitHeap (void);
export void Heap_Lock (void);
static void Heap_Mark (INT64 q);
static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len);
static void Heap_MarkCandidates (INT32 n, INT64 *cand, ADDRESS cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len);
static void Heap_MarkStack (INT64 n, INT64 *cand, ADDRESS cand__len);
export SYSTEM_PTR Heap_NEWBLK (INT64 size);
export SYSTEM_PTR Heap_NEWREC (INT64 tag);
static INT64 Heap_NewChunk (INT64 blksz);
@ -101,16 +104,18 @@ export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
export void Heap_REGTYP (Heap_Module m, INT64 typ);
export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
static void Heap_Scan (void);
static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len);
static void Heap_Sift (INT32 l, INT32 r, INT64 *a, ADDRESS a__len);
export void Heap_Unlock (void);
extern void *Heap__init();
extern ADDRESS Platform_MainStackFrame;
extern ADDRESS Modules_MainStackFrame;
extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
#define Heap_ModulesHalt(code) Modules_Halt(code)
#define Heap_ModulesMainStackFrame() Modules_MainStackFrame
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
#define Heap_uLE(x, y) ((size_t)x <= (size_t)y)
#define Heap_uLT(x, y) ((size_t)x < (size_t)y)
void Heap_Lock (void)
{
@ -143,6 +148,35 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
return (void*)m;
}
INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
{
Heap_Module m, p;
__DUP(name, name__len, CHAR);
m = (Heap_Module)(ADDRESS)Heap_modules;
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m;
m = m->next;
}
if ((m != NIL && m->refcnt == 0)) {
if (m == (Heap_Module)(ADDRESS)Heap_modules) {
Heap_modules = (SYSTEM_PTR)m->next;
} else {
p->next = m->next;
}
__DEL(name);
return 0;
} else {
if (m == NIL) {
__DEL(name);
return -1;
} else {
__DEL(name);
return m->refcnt;
}
}
__RETCHK;
}
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
{
Heap_Cmd c;
@ -170,16 +204,24 @@ void Heap_INCREF (Heap_Module m)
static INT64 Heap_NewChunk (INT64 blksz)
{
INT64 chnk;
INT64 chnk, blk, end;
chnk = Heap_OSAllocate(blksz + 24);
if (chnk != 0) {
__PUT(chnk + 8, chnk + (24 + blksz), INT64);
__PUT(chnk + 24, chnk + 32, INT64);
__PUT(chnk + 32, blksz, INT64);
__PUT(chnk + 40, -8, INT64);
__PUT(chnk + 48, Heap_bigBlocks, INT64);
Heap_bigBlocks = chnk + 24;
blk = chnk + 24;
end = blk + blksz;
__PUT(chnk + 8, end, INT64);
__PUT(blk, blk + 8, INT64);
__PUT(blk + 8, blksz, INT64);
__PUT(blk + 16, -8, INT64);
__PUT(blk + 24, Heap_bigBlocks, INT64);
Heap_bigBlocks = blk;
Heap_heapsize += blksz;
if (Heap_uLT(blk + 8, Heap_heapMin)) {
Heap_heapMin = blk + 8;
}
if (Heap_uLT(Heap_heapMax, end)) {
Heap_heapMax = end;
}
}
return chnk;
}
@ -187,29 +229,28 @@ static INT64 Heap_NewChunk (INT64 blksz)
static void Heap_ExtendHeap (INT64 blksz)
{
INT64 size, chnk, j, next;
if (blksz > 320000) {
if (Heap_uLT(Heap_heapMinExpand, blksz)) {
size = blksz;
} else {
size = 320000;
size = Heap_heapMinExpand;
}
chnk = Heap_NewChunk(size);
if (chnk != 0) {
if (chnk < Heap_heap) {
if (Heap_uLT(chnk, Heap_heap)) {
__PUT(chnk, Heap_heap, INT64);
Heap_heap = chnk;
} else {
j = Heap_heap;
__GET(j, next, INT64);
while ((next != 0 && chnk > next)) {
while ((next != 0 && Heap_uLT(next, chnk))) {
j = next;
__GET(j, next, INT64);
}
__PUT(chnk, next, INT64);
__PUT(j, chnk, INT64);
}
if (next == 0) {
__GET(chnk + 8, Heap_heapend, INT64);
}
} else if (!Heap_firstTry) {
Heap_heapMinExpand = 32;
}
}
@ -219,7 +260,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
SYSTEM_PTR new;
Heap_Lock();
__GET(tag, blksz, INT64);
i0 = __ASHR(blksz, 5);
i0 = __LSH(blksz, -Heap_ldUnit, 64);
i = i0;
if (i < 9) {
adr = Heap_freeList[i];
@ -251,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
if (Heap_firstTry) {
Heap_GC(1);
blksz += 32;
if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize);
t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 64) * 160;
if (Heap_uLT(Heap_heapsize, t)) {
Heap_ExtendHeap(t - Heap_heapsize);
}
Heap_firstTry = 0;
new = Heap_NEWREC(tag);
Heap_firstTry = 1;
if (new == NIL) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize);
Heap_ExtendHeap(blksz);
new = Heap_NEWREC(tag);
}
Heap_firstTry = 1;
Heap_Unlock();
return new;
} else {
@ -269,7 +311,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
}
}
__GET(adr + 8, t, INT64);
if (t >= blksz) {
if (Heap_uLE(blksz, t)) {
break;
}
prev = adr;
@ -280,7 +322,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
__PUT(end + 8, blksz, INT64);
__PUT(end + 16, -8, INT64);
__PUT(end, end + 8, INT64);
if (restsize > 288) {
if (Heap_uLT(288, restsize)) {
__PUT(adr + 8, restsize, INT64);
} else {
__GET(adr + 24, next, INT64);
@ -289,7 +331,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
} else {
__PUT(prev + 24, next, INT64);
}
if (restsize > 0) {
if (restsize != 0) {
di = __ASHR(restsize, 5);
__PUT(adr + 8, restsize, INT64);
__PUT(adr + 24, Heap_freeList[di], INT64);
@ -300,7 +342,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
}
i = adr + 32;
end = adr + blksz;
while (i < end) {
while (Heap_uLT(i, end)) {
__PUT(i, 0, INT64);
__PUT(i + 8, 0, INT64);
__PUT(i + 16, 0, INT64);
@ -397,17 +439,17 @@ static void Heap_Scan (void)
while (chnk != 0) {
adr = chnk + 24;
__GET(chnk + 8, end, INT64);
while (adr < end) {
while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT64);
if (__ODD(tag)) {
if (freesize > 0) {
if (freesize != 0) {
start = adr - freesize;
__PUT(start, start + 8, INT64);
__PUT(start + 8, freesize, INT64);
__PUT(start + 16, -8, INT64);
i = __ASHR(freesize, 5);
i = __LSH(freesize, -Heap_ldUnit, 64);
freesize = 0;
if (i < 9) {
if (Heap_uLT(i, 9)) {
__PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
@ -426,14 +468,14 @@ static void Heap_Scan (void)
adr += size;
}
}
if (freesize > 0) {
if (freesize != 0) {
start = adr - freesize;
__PUT(start, start + 8, INT64);
__PUT(start + 8, freesize, INT64);
__PUT(start + 16, -8, INT64);
i = __ASHR(freesize, 5);
i = __LSH(freesize, -Heap_ldUnit, 64);
freesize = 0;
if (i < 9) {
if (Heap_uLT(i, 9)) {
__PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
@ -445,18 +487,19 @@ static void Heap_Scan (void)
}
}
static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len)
static void Heap_Sift (INT32 l, INT32 r, INT64 *a, ADDRESS a__len)
{
INT64 i, j, x;
INT32 i, j;
INT64 x;
j = l;
x = a[j];
for (;;) {
i = j;
j = __ASHL(j, 1) + 1;
if ((j < r && a[j] < a[j + 1])) {
if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
j += 1;
}
if (j > r || a[j] <= x) {
if (j > r || Heap_uLE(a[j], x)) {
break;
}
a[i] = a[j];
@ -464,9 +507,10 @@ static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len)
a[i] = x;
}
static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len)
static void Heap_HeapSort (INT32 n, INT64 *a, ADDRESS a__len)
{
INT64 l, r, x;
INT32 l, r;
INT64 x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@ -482,37 +526,42 @@ static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len)
}
}
static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len)
static void Heap_MarkCandidates (INT32 n, INT64 *cand, ADDRESS cand__len)
{
INT64 chnk, adr, tag, next, lim, lim1, i, ptr, size;
INT64 chnk, end, adr, tag, next, i, ptr, size;
chnk = Heap_heap;
i = 0;
lim = cand[n - 1];
while ((chnk != 0 && chnk < lim)) {
while (chnk != 0) {
__GET(chnk + 8, end, INT64);
adr = chnk + 24;
__GET(chnk + 8, lim1, INT64);
if (lim < lim1) {
lim1 = lim;
}
while (adr < lim1) {
while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT64);
if (__ODD(tag)) {
__GET(tag - 1, size, INT64);
adr += size;
ptr = adr + 8;
while (Heap_uLT(cand[i], ptr)) {
i += 1;
if (i == (INT64)n) {
return;
}
}
} else {
__GET(tag, size, INT64);
ptr = adr + 8;
while (cand[i] < ptr) {
adr += size;
while (Heap_uLT(cand[i], ptr)) {
i += 1;
}
if (i == n) {
if (i == (INT64)n) {
return;
}
next = adr + size;
if (cand[i] < next) {
}
if (Heap_uLT(cand[i], adr)) {
Heap_Mark(ptr);
}
adr = next;
}
if (Heap_uLE(end, cand[i])) {
adr = end;
}
}
__GET(chnk, chnk, INT64);
@ -571,10 +620,11 @@ void Heap_FINALL (void)
}
}
static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len)
static void Heap_MarkStack (INT64 n, INT64 *cand, ADDRESS cand__len)
{
SYSTEM_PTR frame;
INT64 inc, nofcand, sp, p, stack0;
INT32 nofcand;
INT64 inc, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@ -585,15 +635,15 @@ static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len)
if (n == 0) {
nofcand = 0;
sp = (ADDRESS)&frame;
stack0 = Heap_PlatformMainStackFrame();
stack0 = Heap_ModulesMainStackFrame();
inc = (ADDRESS)&align.p - (ADDRESS)&align;
if (sp > stack0) {
if (Heap_uLT(stack0, sp)) {
inc = -inc;
}
while (sp != stack0) {
__GET(sp, p, INT64);
if ((p > Heap_heap && p < Heap_heapend)) {
if (nofcand == (INT64)cand__len) {
if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
nofcand = 0;
@ -615,7 +665,6 @@ void Heap_GC (BOOLEAN markStack)
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 cand[10000];
if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) {
Heap_Lock();
m = (Heap_Module)(ADDRESS)Heap_modules;
while (m != NIL) {
@ -688,7 +737,6 @@ void Heap_GC (BOOLEAN markStack)
Heap_Finalize();
Heap_Unlock();
}
}
void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
{
@ -703,17 +751,21 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
Heap_heap = Heap_NewChunk(256000);
__GET(Heap_heap + 8, Heap_heapend, INT64);
__PUT(Heap_heap, 0, INT64);
Heap_heap = 0;
Heap_heapsize = 0;
Heap_allocated = 0;
Heap_lockdepth = 0;
Heap_heapMin = -1;
Heap_heapMax = 0;
Heap_bigBlocks = 0;
Heap_heapMinExpand = 256000;
Heap_ldUnit = 5;
Heap_heap = Heap_NewChunk(256000);
__PUT(Heap_heap, 0, INT64);
Heap_firstTry = 1;
Heap_freeList[9] = 1;
Heap_lockdepth = 0;
Heap_FileCount = 0;
Heap_modules = NIL;
Heap_heapsize = 0;
Heap_bigBlocks = 0;
Heap_fin = NIL;
Heap_interrupted = 0;
Heap_HeapModuleInit();

View file

@ -1,16 +1,26 @@
/* voc 1.95 [2016/11/24]. 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
#define Heap__h
#include "SYSTEM.h"
typedef
struct Heap_CmdDesc *Heap_Cmd;
typedef
CHAR Heap_CmdName[24];
typedef
void (*Heap_Command)(void);
typedef
struct Heap_CmdDesc {
Heap_Cmd next;
Heap_CmdName name;
Heap_Command cmd;
} Heap_CmdDesc;
typedef
void (*Heap_EnumProc)(void(*)(SYSTEM_PTR));
@ -21,22 +31,31 @@ typedef
struct Heap_ModuleDesc *Heap_Module;
typedef
struct Heap_ModuleDesc {
INT64 _prvt0;
char _prvt1[56];
} Heap_ModuleDesc;
CHAR Heap_ModuleName[20];
typedef
CHAR Heap_ModuleName[20];
struct Heap_ModuleDesc {
Heap_Module next;
Heap_ModuleName name;
INT32 refcnt;
Heap_Cmd cmds;
INT64 types;
Heap_EnumProc enumPtrs;
char _prvt0[8];
} Heap_ModuleDesc;
import SYSTEM_PTR Heap_modules;
import INT64 Heap_allocated, Heap_heapsize;
import INT64 Heap_allocated;
import INT64 Heap_heap;
import INT64 Heap_heapsize, Heap_heapMinExpand;
import INT16 Heap_FileCount;
import ADDRESS *Heap_ModuleDesc__typ;
import ADDRESS *Heap_CmdDesc__typ;
import void Heap_FINALL (void);
import INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -9,81 +9,303 @@
#include "Heap.h"
#include "Platform.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
typedef
void (*Modules_Command)(void);
typedef
struct Modules_CmdDesc {
Modules_Cmd next;
CHAR name[24];
Modules_Command cmd;
} Modules_CmdDesc;
typedef
struct Modules_ModuleDesc *Modules_Module;
typedef
CHAR Modules_ModuleName[20];
typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
INT32 refcnt;
Modules_Cmd cmds;
INT32 types;
void (*enumPtrs)(void(*)(INT32));
INT32 reserved1, reserved2;
} Modules_ModuleDesc;
export INT16 Modules_res;
export CHAR Modules_resMsg[256];
export Modules_ModuleName Modules_imported, Modules_importing;
export Heap_ModuleName Modules_imported, Modules_importing;
export INT64 Modules_MainStackFrame;
export INT16 Modules_ArgCount;
export INT64 Modules_ArgVector;
export CHAR Modules_BinaryDir[1024];
export ADDRESS *Modules_ModuleDesc__typ;
export ADDRESS *Modules_CmdDesc__typ;
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
export INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
export void Modules_AssertFail (INT32 code);
static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len);
static void Modules_DisplayHaltCode (INT32 code);
export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len);
static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len);
export void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
export void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
export void Modules_GetIntArg (INT16 n, INT32 *val);
export void Modules_Halt (INT32 code);
export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
export void Modules_Init (INT32 argc, INT64 argvadr);
static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len);
static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len);
static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len);
export Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
export Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static void Modules_errch (CHAR c);
static void Modules_errint (INT32 l);
static void Modules_errstring (CHAR *s, LONGINT s__len);
static void Modules_errstring (CHAR *s, ADDRESS s__len);
#define Modules_modules() (Modules_Module)Heap_modules
#define Modules_setmodules(m) Heap_modules = m
extern void Heap_InitHeap();
extern void *Modules__init(void);
#define Modules_InitHeap() Heap_InitHeap()
#define Modules_ModulesInit() Modules__init()
#define Modules_modules() (Heap_Module)Heap_modules
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
void Modules_Init (INT32 argc, INT64 argvadr)
{
INT16 i, j;
__DUP(b, b__len, CHAR);
Modules_MainStackFrame = argvadr;
Modules_ArgCount = __VAL(INT16, argc);
__GET(argvadr, Modules_ArgVector, INT64);
Modules_InitHeap();
Modules_ModulesInit();
}
typedef
CHAR (*argptr__15)[1024];
void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len)
{
argptr__15 arg = NIL;
if (n < Modules_ArgCount) {
__GET(Modules_ArgVector + (INT64)__ASHL(n, 3), arg, argptr__15);
__COPY(*arg, val, val__len);
}
}
void Modules_GetIntArg (INT16 n, INT32 *val)
{
CHAR s[64];
INT32 k, d, i;
s[0] = 0x00;
Modules_GetArg(n, (void*)s, 64);
i = 0;
while (a[__X(i, a__len)] != 0x00) {
if (s[0] == '-') {
i = 1;
}
k = 0;
d = (INT16)s[__X(i, 64)] - 48;
while ((d >= 0 && d <= 9)) {
k = k * 10 + d;
i += 1;
d = (INT16)s[__X(i, 64)] - 48;
}
if (s[0] == '-') {
k = -k;
i -= 1;
}
if (i > 0) {
*val = k;
}
}
INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
{
INT16 i;
CHAR arg[256];
__DUP(s, s__len, CHAR);
i = 0;
Modules_GetArg(i, (void*)arg, 256);
while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
i += 1;
Modules_GetArg(i, (void*)arg, 256);
}
__DEL(s);
return i;
}
static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
i = 0;
while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
j = 0;
while (b[__X(j, b__len)] != 0x00) {
a[__X(i, a__len)] = b[__X(j, b__len)];
__DEL(s);
return i;
}
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0;
j = Modules_CharCount(d, d__len);
while (s[__X(i, s__len)] != 0x00) {
d[__X(j, d__len)] = s[__X(i, s__len)];
i += 1;
j += 1;
}
a[__X(i, a__len)] = 0x00;
__DEL(b);
d[__X(j, d__len)] = 0x00;
__DEL(s);
}
Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
Modules_Module m = NIL;
INT16 i, j;
__DUP(s, s__len, CHAR);
i = 0;
j = Modules_CharCount(d, d__len);
if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
d[__X(j, d__len)] = c;
j += 1;
}
while (s[__X(i, s__len)] != 0x00) {
d[__X(j, d__len)] = s[__X(i, s__len)];
i += 1;
j += 1;
}
d[__X(j, d__len)] = 0x00;
__DEL(s);
}
static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
if (c == 0x00) {
__DEL(s);
return 0;
}
i = 0;
while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
__DEL(s);
return s[__X(i, s__len)] == c;
}
static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
{
__DUP(d, d__len, CHAR);
if (d[0] == 0x00) {
__DEL(d);
return 0;
}
if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
__DEL(d);
return 1;
}
if (d[__X(1, d__len)] == ':') {
__DEL(d);
return 1;
}
__DEL(d);
return 0;
}
static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
__DUP(s, s__len, CHAR);
if (Modules_IsAbsolute(s, s__len)) {
__COPY(s, d, d__len);
} else {
__COPY(Platform_CWD, d, d__len);
Modules_AppendPart('/', s, s__len, (void*)d, d__len);
}
__DEL(s);
}
static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
{
Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__DEL(s);
return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
}
static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
{
INT16 j;
__DUP(s, s__len, CHAR);
__DUP(p, p__len, CHAR);
j = 0;
while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
d[__X(j, d__len)] = s[__X(*i, s__len)];
*i += 1;
j += 1;
}
d[__X(j, d__len)] = 0x00;
while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
*i += 1;
}
__DEL(s);
__DEL(p);
}
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
INT16 i, j;
CHAR part[1024];
__DUP(s, s__len, CHAR);
i = 0;
j = 0;
while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
i += 1;
d[__X(j, d__len)] = '/';
j += 1;
}
d[__X(j, d__len)] = 0x00;
while (s[__X(i, s__len)] != 0x00) {
Modules_ExtractPart(s, s__len, &i, (CHAR*)"/\\", 3, (void*)part, 1024);
if ((part[0] != 0x00 && __STRCMP(part, ".") != 0)) {
Modules_AppendPart('/', part, 1024, (void*)d, d__len);
}
}
__DEL(s);
}
typedef
CHAR pathstring__12[4096];
static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len)
{
pathstring__12 arg0, pathlist, pathdir, tempstr;
INT16 i, j, k;
BOOLEAN present;
if (Modules_ArgCount < 1) {
binarydir[0] = 0x00;
return;
}
Modules_GetArg(0, (void*)arg0, 4096);
i = 0;
while ((((arg0[__X(i, 4096)] != 0x00 && arg0[__X(i, 4096)] != '/')) && arg0[__X(i, 4096)] != '\\')) {
i += 1;
}
if (arg0[__X(i, 4096)] == '/' || arg0[__X(i, 4096)] == '\\') {
Modules_Trim(arg0, 4096, (void*)tempstr, 4096);
Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
present = Modules_IsFilePresent(binarydir, binarydir__len);
} else {
Platform_GetEnv((CHAR*)"PATH", 5, (void*)pathlist, 4096);
i = 0;
present = 0;
while ((!present && pathlist[__X(i, 4096)] != 0x00)) {
Modules_ExtractPart(pathlist, 4096, &i, (CHAR*)":;", 3, (void*)pathdir, 4096);
Modules_AppendPart('/', arg0, 4096, (void*)pathdir, 4096);
Modules_Trim(pathdir, 4096, (void*)tempstr, 4096);
Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
present = Modules_IsFilePresent(binarydir, binarydir__len);
}
}
if (present) {
k = Modules_CharCount(binarydir, binarydir__len);
while ((k > 0 && !Modules_IsOneOf(binarydir[__X(k - 1, binarydir__len)], (CHAR*)"/\\", 3))) {
k -= 1;
}
if (k == 0) {
binarydir[__X(k, binarydir__len)] = 0x00;
} else {
binarydir[__X(k - 1, binarydir__len)] = 0x00;
}
} else {
binarydir[0] = 0x00;
}
}
Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
{
Heap_Module m = NIL;
CHAR bodyname[64];
Modules_Command body;
Heap_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
@ -96,16 +318,16 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_res = 1;
__COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
Modules_Append((void*)Modules_resMsg, 256, name, name__len);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
}
__DEL(name);
return m;
}
Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
{
Modules_Cmd c = NIL;
Heap_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) {
@ -120,43 +342,36 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
__COPY(name, Modules_importing, 20);
Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
Modules_Append((void*)Modules_resMsg, 256, name, name__len);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
Modules_Append(mod->name, 20, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
__DEL(name);
return NIL;
}
__RETCHK;
}
void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
{
Modules_Module m = NIL, p = NIL;
Heap_Module m = NIL, p = NIL;
INT32 refcount;
__DUP(name, name__len, CHAR);
m = Modules_modules();
if (all) {
Modules_res = 1;
__MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
} else {
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m;
m = m->next;
}
if ((m != NIL && m->refcnt == 0)) {
if (m == Modules_modules()) {
Modules_setmodules(m->next);
} else {
p->next = m->next;
}
refcount = Heap_FreeModule(name, name__len);
if (refcount == 0) {
Modules_res = 0;
} else {
Modules_res = 1;
if (m == NIL) {
if (refcount < 0) {
__MOVE("module not found", Modules_resMsg, 17);
} else {
__MOVE("clients of this module exist", Modules_resMsg, 29);
}
Modules_res = 1;
}
}
__DEL(name);
@ -168,7 +383,7 @@ static void Modules_errch (CHAR c)
e = Platform_Write(1, (ADDRESS)&c, 1);
}
static void Modules_errstring (CHAR *s, LONGINT s__len)
static void Modules_errstring (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@ -189,7 +404,7 @@ static void Modules_errint (INT32 l)
if (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)
@ -250,6 +465,7 @@ static void Modules_DisplayHaltCode (INT32 code)
void Modules_Halt (INT32 code)
{
Heap_FINALL();
Modules_errstring((CHAR*)"Terminated by Halt(", 20);
Modules_errint(code);
Modules_errstring((CHAR*)"). ", 4);
@ -262,6 +478,7 @@ void Modules_Halt (INT32 code)
void Modules_AssertFail (INT32 code)
{
Heap_FINALL();
Modules_errstring((CHAR*)"Assertion failure.", 19);
if (code != 0) {
Modules_errstring((CHAR*)" ASSERT code ", 14);
@ -269,11 +486,13 @@ void Modules_AssertFail (INT32 code)
Modules_errstring((CHAR*)".", 2);
}
Modules_errstring(Platform_NL, 3);
if (code > 0) {
Platform_Exit(code);
} else {
Platform_Exit(-1);
}
}
__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 64), {0, 32, -24}};
__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 40), {0, -16}};
export void *Modules__init(void)
{
@ -281,8 +500,7 @@ export void *Modules__init(void)
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
__INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
__INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
/* BEGIN */
Modules_FindBinaryDir((void*)Modules_BinaryDir, 1024);
__ENDMOD;
}

View file

@ -1,53 +1,30 @@
/* voc 1.95 [2016/11/24]. 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
#define Modules__h
#include "SYSTEM.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
typedef
void (*Modules_Command)(void);
typedef
struct Modules_CmdDesc {
Modules_Cmd next;
CHAR name[24];
Modules_Command cmd;
} Modules_CmdDesc;
typedef
struct Modules_ModuleDesc *Modules_Module;
typedef
CHAR Modules_ModuleName[20];
typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
INT32 refcnt;
Modules_Cmd cmds;
INT32 types;
void (*enumPtrs)(void(*)(INT32));
char _prvt0[8];
} Modules_ModuleDesc;
#include "Heap.h"
import INT16 Modules_res;
import CHAR Modules_resMsg[256];
import Modules_ModuleName Modules_imported, Modules_importing;
import Heap_ModuleName Modules_imported, Modules_importing;
import INT64 Modules_MainStackFrame;
import INT16 Modules_ArgCount;
import INT64 Modules_ArgVector;
import CHAR Modules_BinaryDir[1024];
import ADDRESS *Modules_ModuleDesc__typ;
import ADDRESS *Modules_CmdDesc__typ;
import INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
import void Modules_AssertFail (INT32 code);
import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
import void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
import void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
import void Modules_GetIntArg (INT16 n, INT32 *val);
import void Modules_Halt (INT32 code);
import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
import void Modules_Init (INT32 argc, INT64 argvadr);
import Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
import Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
import void *Modules__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -253,7 +253,7 @@ OPT_Node OPB_NewString (OPS_String str, INT64 len)
x->conval->intval = -1;
x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
__COPY(str, *x->conval->ext, 256);
__MOVE(str, *x->conval->ext, 256);
return x;
}
@ -261,7 +261,7 @@ static void OPB_CharToString (OPT_Node n)
{
CHAR ch;
n->typ = OPT_stringtyp;
ch = (CHAR)n->conval->intval;
ch = __CHR(n->conval->intval);
n->conval->ext = OPT_NewExt();
if (ch == 0x00) {
n->conval->intval2 = 1;
@ -550,7 +550,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
if (f == 4) {
if (z->conval->intval == (-9223372036854775807-1)) {
if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
@ -577,7 +577,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
if (f == 4) {
if (z->conval->intval == (-9223372036854775807-1)) {
if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = __ABS(z->conval->intval);
@ -597,7 +597,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
case 22:
if (f == 3) {
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;
} else {
z = NewOp__29(op, typ, z);
@ -920,7 +920,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
if (f == 4) {
xv = xval->intval;
yv = yval->intval;
if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807LL, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807LL-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807LL-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807LL-1))) && yv != (-9223372036854775807LL-1))) && -xv <= __DIV(9223372036854775807LL, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
@ -999,8 +999,8 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 6:
if (f == 4) {
temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807LL - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
@ -1023,7 +1023,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 7:
if (f == 4) {
if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203);
r = (LONGREAL)1;
}
(*x)->conval->intval = (INT32)__ENTIER(r);
(*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL);
OPB_SetIntType(*x);
}
}
@ -1624,23 +1624,20 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
g = 8;
}
if (x == y) {
} else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) {
} else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) {
OPB_err(113);
} else if (x->BaseTyp == OPT_chartyp) {
if (g == 8) {
if (ynode->conval->intval2 > x->n) {
OPB_err(114);
}
} else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
} else {
OPB_err(113);
}
} else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
} else if (x->comp == 4) {
if (x == y) {
} else if (y->comp == 4) {
@ -2091,7 +2088,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, (INT64)__ASH(1, x->conval->intval))) {
if (__ABS(p->conval->intval) <= __DIV(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
} else {
OPB_err(208);
@ -2536,7 +2533,6 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@ -2562,13 +2558,8 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
y->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(0));
}
if ((((((__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c, 32))) && y->typ->BaseTyp == OPT_chartyp)) {
subcl = 18;
} else {
subcl = 0;
}
OPB_BindNodes(19, OPT_notyp, &*x, y);
(*x)->subcl = subcl;
(*x)->subcl = 0;
}
void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
@ -2595,7 +2586,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
OPB_maxExp = OPB_log(4611686018427387904);
OPB_maxExp = OPB_log(4611686018427387904LL);
OPB_maxExp = OPB_exp;
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPB__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -56,7 +56,7 @@ static void OPC_GenHeaderMsg (void);
export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
static void OPC_IdentList (OPT_Object obj, INT16 vis);
static void OPC_Include (CHAR *name, LONGINT name__len);
static void OPC_Include (CHAR *name, ADDRESS name__len);
static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
export void OPC_Indent (INT16 count);
@ -68,11 +68,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
export void OPC_IntLiteral (INT64 n, INT32 size);
export void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName);
static INT16 OPC_Length (CHAR *s, LONGINT s__len);
static INT16 OPC_Length (CHAR *s, ADDRESS s__len);
export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
export INT32 OPC_NofPtrs (OPT_Struct typ);
static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
@ -80,8 +80,8 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l);
static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
@ -137,7 +137,7 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
{
CHAR ch;
INT16 i;
@ -156,7 +156,7 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
__DEL(s);
}
static INT16 OPC_Length (CHAR *s, LONGINT s__len)
static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@ -166,7 +166,7 @@ static INT16 OPC_Length (CHAR *s, LONGINT s__len)
return i;
}
static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
{
INT16 i, h;
i = 0;
@ -364,7 +364,7 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
OPC_Str1((CHAR*)"ADDRESS len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
@ -511,7 +511,7 @@ static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamNa
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
OPM_WriteString((CHAR*)", LONGINT ", 11);
OPM_WriteString((CHAR*)", ADDRESS ", 11);
} else {
OPM_WriteString((CHAR*)", ", 3);
}
@ -618,7 +618,8 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
{
if (obj != NIL) {
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))) {
if (OPM_currFile == 1 || (OPM_currFile == 0 && obj->vis == 1)) {
OPM_WriteString((CHAR*)"#define __", 11);
OPC_Ident(obj);
OPC_DeclareParams(obj->link, 1);
@ -644,6 +645,7 @@ static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
OPM_Write(')');
OPM_WriteLn();
}
}
OPC_DefineTProcMacros(obj->right, &*empty);
}
}
@ -652,7 +654,7 @@ static void OPC_DefineType (OPT_Struct str)
{
OPT_Object obj = NIL, field = NIL, par = NIL;
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;
if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) {
@ -681,6 +683,10 @@ static void OPC_DefineType (OPT_Struct str)
OPC_DefineType(str->BaseTyp);
}
} 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);
} else if (str->form == 12) {
if (str->BaseTyp != OPT_notyp) {
@ -715,12 +721,19 @@ static void OPC_DefineType (OPT_Struct str)
if (!empty) {
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();
}
}
}
}
}
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
{
INT16 i;
__DUP(y, y__len, CHAR);
@ -968,8 +981,8 @@ static void OPC_IdentList (OPT_Object obj, INT16 vis)
if (obj->typ->comp == 3) {
OPC_EndStat();
OPC_BegStat();
base = OPT_linttyp;
OPM_WriteString((CHAR*)"LONGINT ", 9);
base = OPT_adrtyp;
OPM_WriteString((CHAR*)"ADDRESS ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
@ -1008,7 +1021,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
__COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
OPM_WriteString((CHAR*)", LONGINT ", 11);
OPM_WriteString((CHAR*)", ADDRESS ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPM_WriteString((CHAR*)", ADDRESS *", 12);
@ -1062,7 +1075,7 @@ static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
}
}
static void OPC_Include (CHAR *name, LONGINT name__len)
static void OPC_Include (CHAR *name, ADDRESS name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", 10);
@ -1138,7 +1151,7 @@ static void OPC_GenHeaderMsg (void)
OPM_WriteString((CHAR*)"/* ", 4);
OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, 75);
OPM_WriteString(Configuration_versionLong, 76);
OPM_Write(' ');
i = 0;
while (i <= 31) {
@ -1659,9 +1672,9 @@ void OPC_CompleteIdent (OPT_Object obj)
OPC_Ident(obj);
OPM_WriteString((CHAR*)"__", 3);
} else {
OPM_WriteString((CHAR*)"((", 3);
OPM_WriteString((CHAR*)"(*(", 4);
OPC_Ident(obj->typ->strobj);
OPM_Write(')');
OPM_WriteString((CHAR*)"*)&", 4);
OPC_Ident(obj);
OPM_Write(')');
}
@ -1739,12 +1752,12 @@ static void OPC_CharacterLiteral (INT64 c)
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write(__CHR(c));
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
{
INT32 i;
INT16 c;
@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
OPM_Write(__CHR(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
OPM_Write(__CHR(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write((CHAR)(48 + c));
OPM_Write(__CHR(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write((CHAR)c);
OPM_Write(__CHR(c));
}
i += 1;
}
@ -1830,6 +1843,12 @@ void OPC_IntLiteral (INT64 n, INT32 size)
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) {
OPC_CompleteIdent(obj);
OPM_WriteString((CHAR*)"__len", 6);
@ -1837,10 +1856,6 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
OPM_WriteInt(dim);
}
} else {
while (dim > 0) {
array = array->BaseTyp;
dim -= 1;
}
OPM_WriteInt(array->n);
}
}
@ -1912,9 +1927,9 @@ static struct InitKeywords__46 {
struct InitKeywords__46 *lnk;
} *InitKeywords__46_s;
static void Enter__47 (CHAR *s, LONGINT s__len);
static void Enter__47 (CHAR *s, ADDRESS s__len);
static void Enter__47 (CHAR *s, LONGINT s__len)
static void Enter__47 (CHAR *s, ADDRESS s__len)
{
INT16 h;
__DUP(s, s__len, CHAR);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPC__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -8,6 +8,7 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@ -18,6 +19,8 @@ typedef
CHAR OPM_FileName[32];
static CHAR OPM_currentComment[256];
static BOOLEAN OPM_hasComment;
static CHAR OPM_SourceFileName[256];
static CHAR OPM_GlobalModel[10];
export CHAR OPM_Model[10];
@ -26,7 +29,7 @@ export INT16 OPM_AddressSize;
static INT16 OPM_GlobalAlignment;
export INT16 OPM_Alignment;
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 LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
@ -41,41 +44,48 @@ static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
static INT16 OPM_S;
export CHAR OPM_InstallDir[1024];
export CHAR OPM_ResourceDir[1024];
static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
export void OPM_DeleteNewSym (void);
export void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_FPrint (INT32 *fp, INT64 val);
export void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
export void OPM_FPrintReal (INT32 *fp, REAL val);
export void OPM_FPrintSet (INT32 *fp, UINT64 val);
static void OPM_FindInstallDir (void);
static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch);
export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
export void OPM_GetComment (CHAR *text, ADDRESS text__len);
export void OPM_Init (BOOLEAN *done);
export void OPM_InitOptions (void);
export INT16 OPM_Integer (INT64 n);
static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len);
export void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
static void OPM_LogErrMsg (INT16 n);
export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
export void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
export void OPM_LogWNum (INT64 i, INT64 len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
export void OPM_LogWStr (CHAR *s, ADDRESS s__len);
export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
export void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
export void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
static void OPM_ScanOptions (CHAR *s, LONGINT s__len);
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len);
static void OPM_ShowLine (INT64 pos);
export INT64 OPM_SignedMaximum (INT32 bytecount);
export INT64 OPM_SignedMinimum (INT32 bytecount);
export void OPM_StoreComment (CHAR *text, ADDRESS text__len);
export void OPM_SymRCh (CHAR *ch);
export INT32 OPM_SymRInt (void);
export INT64 OPM_SymRInt64 (void);
@ -87,14 +97,13 @@ export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
export void OPM_SymWSet (UINT64 s);
static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
export void OPM_WriteHex (INT64 i);
export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export void OPM_WriteString (CHAR *s, ADDRESS s__len);
export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);
@ -105,7 +114,7 @@ void OPM_LogW (CHAR ch)
Out_Char(ch);
}
void OPM_LogWStr (CHAR *s, LONGINT s__len)
void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{
__DUP(s, s__len, CHAR);
Out_String(s, s__len);
@ -122,7 +131,7 @@ void OPM_LogWLn (void)
Out_Ln();
}
void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
@ -131,6 +140,57 @@ void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
__DEL(vt100code);
}
void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
{
__DUP(modname, modname__len, CHAR);
OPM_LogWStr((CHAR*)"Compiling ", 11);
OPM_LogWStr(modname, modname__len);
if (__IN(18, OPM_Options, 32)) {
OPM_LogWStr((CHAR*)", s:", 5);
OPM_LogWNum(__ASHL(OPM_ShortintSize, 3), 1);
OPM_LogWStr((CHAR*)" i:", 4);
OPM_LogWNum(__ASHL(OPM_IntegerSize, 3), 1);
OPM_LogWStr((CHAR*)" l:", 4);
OPM_LogWNum(__ASHL(OPM_LongintSize, 3), 1);
OPM_LogWStr((CHAR*)" adr:", 6);
OPM_LogWNum(__ASHL(OPM_AddressSize, 3), 1);
OPM_LogWStr((CHAR*)" algn:", 7);
OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
}
OPM_LogW('.');
__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 result;
@ -154,7 +214,7 @@ INT16 OPM_Integer (INT64 n)
return __VAL(INT16, n);
}
static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@ -227,29 +287,6 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
i += 2;
}
break;
case 'B':
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
}
if (s[__X(i + 1, s__len)] != 0x00) {
i += 1;
OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
}
__ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
__ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
__ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
if (OPM_IntegerSize == 2) {
OPM_LongintSize = 4;
} else {
OPM_LongintSize = 8;
}
Files_SetSearchPath((CHAR*)"", 1);
break;
default:
OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
@ -266,16 +303,19 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
BOOLEAN OPM_OpenPar (void)
{
CHAR s[256];
if (Platform_ArgCount == 1) {
if (Modules_ArgCount == 1) {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
OPM_LogWStr(Configuration_versionLong, 75);
OPM_LogWStr(Configuration_versionLong, 76);
OPM_LogW('.');
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Further development by Norayr Chilingarian, David Brown and others.", 68);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Loaded from ", 13);
OPM_LogWStr(Modules_BinaryDir, 1024);
OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
@ -332,7 +372,7 @@ BOOLEAN OPM_OpenPar (void)
OPM_LogWLn();
OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
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_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn();
@ -362,64 +402,38 @@ BOOLEAN OPM_OpenPar (void)
OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
}
OPM_GlobalAddressSize = OPM_AddressSize;
OPM_GlobalAlignment = OPM_Alignment;
__COPY(OPM_Model, OPM_GlobalModel, 10);
__MOVE(OPM_Model, OPM_GlobalModel, 10);
OPM_GlobalOptions = OPM_Options;
return 1;
}
__RETCHK;
}
static void OPM_VerboseListSizes (void)
{
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Type Size", 15);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SHORTINT ", 12);
OPM_LogWNum(OPM_ShortintSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"INTEGER ", 12);
OPM_LogWNum(OPM_IntegerSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"LONGINT ", 12);
OPM_LogWNum(OPM_LongintSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"SET ", 12);
OPM_LogWNum(OPM_LongintSize, 4);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"ADDRESS ", 12);
OPM_LogWNum(OPM_AddressSize, 4);
OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Alignment: ", 12);
OPM_LogWNum(OPM_Alignment, 4);
OPM_LogWLn();
}
void OPM_InitOptions (void)
{
CHAR s[256];
CHAR searchpath[1024], modules[1024];
CHAR MODULES[1024];
OPM_Options = OPM_GlobalOptions;
__COPY(OPM_GlobalModel, OPM_Model, 10);
__MOVE(OPM_GlobalModel, OPM_Model, 10);
OPM_Alignment = OPM_GlobalAlignment;
OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
}
if (__IN(15, OPM_Options, 32)) {
OPM_Options |= __SETOF(10,32);
@ -430,29 +444,32 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
case 'C':
OPM_ShortintSize = 2;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 4;
break;
case 'V':
OPM_ShortintSize = 1;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 8;
break;
default:
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
}
if (__IN(18, OPM_Options, 32)) {
OPM_VerboseListSizes();
}
OPM_ResourceDir[0] = 0x00;
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
if (OPM_ResourceDir[0] != 0x00) {
Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
}
modules[0] = 0x00;
Platform_GetEnv((CHAR*)"MODULES", 8, (void*)modules, 1024);
__MOVE(".", searchpath, 2);
@ -465,23 +482,22 @@ void OPM_InitOptions (void)
Files_SetSearchPath(searchpath, 1024);
}
void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
void OPM_Init (BOOLEAN *done)
{
Texts_Text T = NIL;
INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
if (OPM_S >= Platform_ArgCount) {
if (OPM_S >= Modules_ArgCount) {
return;
}
s[0] = 0x00;
Platform_GetArg(OPM_S, (void*)s, 256);
Modules_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
Texts_Open(T, s, 256);
OPM_LogWStr(s, 256);
OPM_LogWStr((CHAR*)" ", 3);
__COPY(s, mname, mname__len);
__COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
OPM_LogWStr(s, 256);
@ -503,18 +519,14 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
void OPM_Get (CHAR *ch)
{
Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
if (*ch == 0x0d) {
OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
} else {
OPM_curpos += 1;
}
Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
if ((*ch < 0x09 && !OPM_inR.eot)) {
*ch = ' ';
}
}
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
{
INT16 i, j;
CHAR ch;
@ -632,7 +644,7 @@ static void OPM_ShowLine (INT64 pos)
if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1;
}
i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768);
while (i > 0) {
OPM_LogW(' ');
i -= 1;
@ -640,7 +652,6 @@ static void OPM_ShowLine (INT64 pos)
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
OPM_LogVT100((CHAR*)"0m", 3);
Files_Close(f);
}
void OPM_Mark (INT16 n, INT32 pos)
@ -700,7 +711,7 @@ void OPM_err (INT16 n)
OPM_Mark(n, OPM_errpos);
}
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
{
INT16 i;
INT32 l;
@ -772,10 +783,13 @@ void OPM_CloseOldSym (void)
Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
{
CHAR tag, ver;
OPM_FileName fileName;
INT16 res;
OPM_oldSFile = NIL;
*done = 0;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
@ -783,8 +797,10 @@ void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
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*)&ver);
if (tag != 0xf7 || ver != 0x82) {
if (tag != 0xf7 || ver != 0x84) {
if (!__IN(4, OPM_Options, 32)) {
OPM_err(-306);
}
OPM_CloseOldSym();
*done = 0;
}
@ -828,11 +844,23 @@ void OPM_RegisterNewSym (void)
}
}
void OPM_DeleteNewSym (void)
void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
{
OPM_FileName fn;
INT16 res;
OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
Files_Delete(fn, 32, &res);
}
void OPM_NewSym (CHAR *modName, LONGINT modName__len)
void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len)
{
OPM_FileName fn;
INT16 res;
OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".o", 3);
Files_Delete(fn, 32, &res);
}
void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
{
OPM_FileName fileName;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
@ -840,7 +868,7 @@ void OPM_NewSym (CHAR *modName, LONGINT modName__len)
if (OPM_newSFile != NIL) {
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, 0x82);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
} else {
OPM_err(153);
}
@ -851,7 +879,7 @@ void OPM_Write (CHAR ch)
Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
void OPM_WriteString (CHAR *s, LONGINT s__len)
void OPM_WriteString (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@ -861,7 +889,7 @@ void OPM_WriteString (CHAR *s, LONGINT s__len)
Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@ -875,17 +903,17 @@ void OPM_WriteHex (INT64 i)
{
CHAR s[3];
INT32 digit;
digit = __ASHR((INT32)i, 4);
digit = __ASHR(__SHORT(i, 2147483648LL), 4);
if (digit < 10) {
s[0] = (CHAR)(48 + digit);
s[0] = __CHR(48 + digit);
} 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) {
s[1] = (CHAR)(48 + digit);
s[1] = __CHR(48 + digit);
} else {
s[1] = (CHAR)(87 + digit);
s[1] = __CHR(87 + digit);
}
s[2] = 0x00;
OPM_WriteString(s, 3);
@ -893,7 +921,7 @@ void OPM_WriteHex (INT64 i)
void OPM_WriteInt (INT64 i)
{
CHAR s[24];
CHAR s[26];
INT64 i1, k;
if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
@ -901,21 +929,27 @@ void OPM_WriteInt (INT64 i)
OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
s[0] = (CHAR)(__MOD(i1, 10) + 48);
if (i1 <= 2147483647) {
k = 0;
} else {
__MOVE("LL", s, 3);
k = 2;
}
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k = 1;
k += 1;
while (i1 > 0) {
s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
s[__X(k, 24)] = '-';
s[__X(k, 26)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
OPM_Write(s[__X(k, 24)]);
OPM_Write(s[__X(k, 26)]);
}
}
}
@ -928,13 +962,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx)
CHAR s[32];
CHAR ch;
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') {
OPM_WriteString((CHAR*)"(REAL)", 7);
} else {
OPM_WriteString((CHAR*)"(LONGREAL)", 11);
}
OPM_WriteInt((INT32)__ENTIER(r));
OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {
@ -986,9 +1020,9 @@ static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
}
}
void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
{
CHAR FName[32];
OPM_FileName FName;
__COPY(moduleName, OPM_modName, 32);
OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
@ -1014,7 +1048,7 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
CHAR FName[32];
OPM_FileName FName;
INT16 res;
if (OPM_noerr) {
OPM_LogWStr((CHAR*)" ", 3);
@ -1050,6 +1084,59 @@ void OPM_CloseFiles (void)
Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
{
CHAR testpath[4096];
Platform_FileIdentity identity;
__DUP(s, s__len, CHAR);
__COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0;
}
__COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0;
}
__COPY(OPM_InstallDir, testpath, 4096);
Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
__DEL(s);
return 0;
}
__DEL(s);
return 1;
}
static void OPM_FindInstallDir (void)
{
INT16 i;
__COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
Strings_Append((CHAR*)"/", 2, (void*)OPM_InstallDir, 1024);
Strings_Append((CHAR*)"voc", 4, (void*)OPM_InstallDir, 1024);
Strings_Append((CHAR*)".d", 3, (void*)OPM_InstallDir, 1024);
if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
return;
}
__COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
i = Strings_Length(OPM_InstallDir, 1024);
while ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] != '/')) {
i -= 1;
}
if ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] == '/')) {
OPM_InstallDir[__X(i - 1, 1024)] = 0x00;
if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
return;
}
}
__COPY("", OPM_InstallDir, 1024);
}
static void EnumPtrs(void (*P)(void*))
{
__ENUMR(&OPM_inR, Texts_Reader__typ, 72, 1, P);
@ -1071,6 +1158,7 @@ export void *OPM__init(void)
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Files);
__MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
@ -1079,7 +1167,6 @@ export void *OPM__init(void)
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
__REGCMD("DeleteNewSym", OPM_DeleteNewSym);
__REGCMD("InitOptions", OPM_InitOptions);
__REGCMD("LogWLn", OPM_LogWLn);
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
@ -1089,5 +1176,8 @@ export void *OPM__init(void)
OPM_MaxLReal = 1.79769296342094e+308;
OPM_MinReal = -OPM_MaxReal;
OPM_MinLReal = -OPM_MaxLReal;
OPM_FindInstallDir();
OPM_hasComment = 0;
OPM_currentComment[0] = 0x00;
__ENDMOD;
}

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPM__h
@ -9,7 +9,7 @@
import CHAR OPM_Model[10];
import INT16 OPM_AddressSize, OPM_Alignment;
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 LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
@ -17,34 +17,39 @@ import INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
import INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
import CHAR OPM_modName[32];
import CHAR OPM_objname[64];
import CHAR OPM_InstallDir[1024];
import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
import void OPM_DeleteNewSym (void);
import void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
import void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
import void OPM_FPrint (INT32 *fp, INT64 val);
import void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
import void OPM_FPrintReal (INT32 *fp, REAL val);
import void OPM_FPrintSet (INT32 *fp, UINT64 val);
import void OPM_Get (CHAR *ch);
import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
import void OPM_GetComment (CHAR *text, ADDRESS text__len);
import void OPM_Init (BOOLEAN *done);
import void OPM_InitOptions (void);
import INT16 OPM_Integer (INT64 n);
import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
import void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
import void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
import void OPM_LogWNum (INT64 i, INT64 len);
import void OPM_LogWStr (CHAR *s, LONGINT s__len);
import void OPM_LogWStr (CHAR *s, ADDRESS s__len);
import INT32 OPM_Longint (INT64 n);
import void OPM_Mark (INT16 n, INT32 pos);
import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
import void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
import void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void);
import INT64 OPM_SignedMaximum (INT32 bytecount);
import INT64 OPM_SignedMinimum (INT32 bytecount);
import void OPM_StoreComment (CHAR *text, ADDRESS text__len);
import void OPM_SymRCh (CHAR *ch);
import INT32 OPM_SymRInt (void);
import INT64 OPM_SymRInt64 (void);
@ -61,8 +66,8 @@ import void OPM_WriteHex (INT64 i);
import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
import void OPM_WriteString (CHAR *s, LONGINT s__len);
import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
import void OPM_WriteString (CHAR *s, ADDRESS s__len);
import void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
import BOOLEAN OPM_eofSF (void);
import void OPM_err (INT16 n);
import void *OPM__init(void);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -527,7 +527,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
__COPY(OPS_name, name, 256);
__MOVE(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
if ((*x)->typ->form == 11) {
@ -634,7 +634,7 @@ static void OPP_StandProcCall (OPT_Node *x)
OPT_Node y = NIL;
INT8 m;
INT16 n;
m = (INT8)((INT16)(*x)->obj->adr);
m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128);
n = 0;
if (OPP_sym == 30) {
OPS_Get(&OPP_sym);
@ -867,7 +867,7 @@ static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct
} else {
*mode = 1;
}
__COPY(OPS_name, name, 256);
__MOVE(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@ -943,7 +943,7 @@ static void GetCode__19 (void)
(*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
n += 1;
}
(*ext)[0] = (CHAR)n;
(*ext)[0] = __CHR(n);
OPS_Get(&OPP_sym);
} else {
for (;;) {
@ -956,14 +956,14 @@ static void GetCode__19 (void)
n = 1;
}
OPS_Get(&OPP_sym);
(*ext)[__X(n, 256)] = (CHAR)c;
(*ext)[__X(n, 256)] = __CHR(c);
}
if (OPP_sym == 19) {
OPS_Get(&OPP_sym);
} else if (OPP_sym == 35) {
OPP_err(19);
} else {
(*ext)[0] = (CHAR)n;
(*ext)[0] = __CHR(n);
break;
}
}
@ -1030,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
__COPY(OPS_name, *ProcedureDeclaration__16_s->name, 256);
__MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
OPP_CheckMark(&*ProcedureDeclaration__16_s->vis);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc);
@ -1129,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
__COPY(OPS_name, name, 256);
__MOVE(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@ -1665,6 +1665,9 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
obj->typ = OPT_undftyp;
OPP_CheckMark(&obj->vis);
if (OPP_sym == 9) {
if (((((((((__STRCMP(obj->name, "SHORTINT") == 0 || __STRCMP(obj->name, "INTEGER") == 0) || __STRCMP(obj->name, "LONGINT") == 0) || __STRCMP(obj->name, "HUGEINT") == 0) || __STRCMP(obj->name, "REAL") == 0) || __STRCMP(obj->name, "LONGREAL") == 0) || __STRCMP(obj->name, "SET") == 0) || __STRCMP(obj->name, "CHAR") == 0) || __STRCMP(obj->name, "TRUE") == 0) || __STRCMP(obj->name, "FALSE") == 0) {
OPM_Mark(-310, OPM_curpos);
}
OPS_Get(&OPP_sym);
OPP_TypeDecl(&obj->typ, &obj->typ);
} else if (OPP_sym == 34 || OPP_sym == 20) {
@ -1790,30 +1793,10 @@ void OPP_Module (OPT_Node *prog, UINT32 opt)
if (OPP_sym == 63) {
OPS_Get(&OPP_sym);
} else {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" sym: ", 15);
OPM_LogWNum(OPP_sym, 1);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.name: ", 15);
OPM_LogWStr(OPS_name, 256);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.str: ", 15);
OPM_LogWStr(OPS_str, 256);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
OPM_LogWNum(OPS_numtyp, 1);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
OPM_LogWNum(OPS_intval, 1);
OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
OPM_LogWStr((CHAR*)"compiling ", 11);
OPM_LogWStr(OPS_name, 256);
OPM_LogW('.');
OPM_LogCompiling(OPS_name, 256);
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
OPP_CheckSym(39);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPP__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym)
OPS_err(241);
break;
}
OPS_str[i] = OPS_ch;
OPS_str[__X(i, 256)] = OPS_ch;
i += 1;
}
OPM_Get(&OPS_ch);
OPS_str[i] = 0x00;
OPS_str[__X(i, 256)] = 0x00;
OPS_intval = i + 1;
if (OPS_intval == 2) {
*sym = 35;
@ -76,7 +76,7 @@ static void OPS_Identifier (INT8 *sym)
INT16 i;
i = 0;
do {
OPS_name[i] = OPS_ch;
OPS_name[__X(i, 256)] = OPS_ch;
i += 1;
OPM_Get(&OPS_ch);
} 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);
i -= 1;
}
OPS_name[i] = 0x00;
OPS_name[__X(i, 256)] = 0x00;
*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 (m > 0 || OPS_ch != '0') {
if (n < 24) {
dig[n] = OPS_ch;
dig[__X(n, 24)] = OPS_ch;
n += 1;
}
m += 1;
@ -173,7 +173,7 @@ static void OPS_Number (void)
OPS_numtyp = 1;
if (n <= 2) {
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;
}
} else {
@ -187,7 +187,7 @@ static void OPS_Number (void)
OPS_intval = -1;
}
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;
}
} else {
@ -196,9 +196,9 @@ static void OPS_Number (void)
} else {
OPS_numtyp = 2;
while (i < n) {
d = Ord__7(dig[i], 0);
d = Ord__7(dig[__X(i, 24)], 0);
i += 1;
if (OPS_intval <= __DIV(9223372036854775807 - (INT64)d, 10)) {
if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
@ -214,7 +214,7 @@ static void OPS_Number (void)
expCh = 'E';
while (n > 0) {
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') {
expCh = OPS_ch;
@ -279,32 +279,74 @@ static void Comment__2 (void);
static void Comment__2 (void)
{
OPM_Get(&OPS_ch);
for (;;) {
for (;;) {
while (OPS_ch == '(') {
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);
if (OPS_ch == '*') {
Comment__2();
}
}
if (OPS_ch == '*') {
isExported = 1;
OPM_Get(&OPS_ch);
break;
}
if (OPS_ch == 0x00) {
break;
}
OPM_Get(&OPS_ch);
}
if (OPS_ch == ')') {
commentText[0] = 0x00;
OPM_StoreComment(commentText, 256);
OPM_Get(&OPS_ch);
break;
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);
} else {
prevCh = 0x00;
}
} else {
if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
}
}
prevCh = OPS_ch;
}
if (nestLevel > 0) {
OPM_Get(&OPS_ch);
}
}
if (OPS_ch == 0x00) {
OPS_err(5);
break;
}
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 (isExported) {
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 1.95 [2016/11/24]. 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
#define OPS__h

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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 INTEGER INT16
@ -49,6 +49,15 @@ typedef
INT8 glbmno[64];
} OPT_ImpCtxt;
typedef
struct OPT_LinkDesc *OPT_Link;
typedef
struct OPT_LinkDesc {
OPS_Name name;
OPT_Link next;
} OPT_LinkDesc;
typedef
struct OPT_NodeDesc *OPT_Node;
@ -74,6 +83,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -101,6 +111,7 @@ static OPT_ExpCtxt OPT_expCtxt;
static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
static INT32 OPT_recno;
export OPT_Link OPT_Links;
export ADDRESS *OPT_ConstDesc__typ;
export ADDRESS *OPT_ObjDesc__typ;
@ -108,6 +119,7 @@ export ADDRESS *OPT_StrDesc__typ;
export ADDRESS *OPT_NodeDesc__typ;
export ADDRESS *OPT_ImpCtxt__typ;
export ADDRESS *OPT_ExpCtxt__typ;
export ADDRESS *OPT_LinkDesc__typ;
export void OPT_Align (INT32 *adr, INT32 base);
export INT32 OPT_BaseAlignment (OPT_Struct typ);
@ -120,7 +132,7 @@ static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res);
export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len);
export void OPT_FPrintObj (OPT_Object obj);
static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
@ -131,8 +143,9 @@ export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
static void OPT_InLinks (void);
static void OPT_InMod (INT8 *mno);
static void OPT_InName (CHAR *name, LONGINT name__len);
static void OPT_InName (CHAR *name, ADDRESS name__len);
static OPT_Object OPT_InObj (INT8 mno);
static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par);
static void OPT_InStruct (OPT_Struct *typ);
@ -154,12 +167,14 @@ export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
static void OPT_OutLinks (void);
static void OPT_OutMod (INT16 mno);
static void OPT_OutName (CHAR *name, LONGINT name__len);
static void OPT_OutName (CHAR *name, ADDRESS name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
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_ShorterOrLongerType (OPT_Struct x, INT16 dir);
export INT32 OPT_SizeAlignment (INT32 size);
@ -339,7 +354,7 @@ void OPT_TypSize (OPT_Struct typ)
}
typ->size = offset;
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) {
OPT_TypSize(typ->BaseTyp);
typ->size = typ->n * typ->BaseTyp->size;
@ -375,6 +390,10 @@ OPT_Object OPT_NewObj (void)
{
OPT_Object obj = NIL;
__NEW(obj, OPT_ObjDesc);
obj->typ = NIL;
obj->conval = NIL;
obj->comment = NIL;
obj->name[0] = 0x00;
return obj;
}
@ -434,14 +453,16 @@ void OPT_Init (OPS_Name name, UINT32 opt)
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
__COPY(name, OPT_SelfName, 256);
__COPY(name, OPT_topScope->name, 256);
__MOVE(name, OPT_SelfName, 256);
__MOVE(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
OPT_newsf = __IN(4, opt, 32);
OPT_findpc = __IN(8, opt, 32);
OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
__NEW(OPT_Links, OPT_LinkDesc);
__MOVE(name, OPT_Links->name, 256);
}
void OPT_Close (void)
@ -539,6 +560,8 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
OPT_Object ob0 = NIL, ob1 = NIL;
BOOLEAN left;
INT8 mnolev;
CHAR commentText[256];
INT16 j;
ob0 = OPT_topScope;
ob1 = ob0->right;
left = 0;
@ -570,13 +593,23 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj)
__COPY(name, ob1->name, 256);
mnolev = OPT_topScope->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;
}
}
*obj = ob1;
}
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -957,7 +990,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
}
}
static void OPT_InName (CHAR *name, LONGINT name__len)
static void OPT_InName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -1011,6 +1044,26 @@ static void OPT_InMod (INT8 *mno)
}
}
static void OPT_InLinks (void)
{
OPS_Name linkname;
OPT_Link l = NIL;
OPT_InName((void*)linkname, 256);
while (linkname[0] != 0x00) {
l = OPT_Links;
while ((l != NIL && __STRCMP(l->name, linkname) != 0)) {
l = l->next;
}
if (l == NIL) {
l = OPT_Links;
__NEW(OPT_Links, OPT_LinkDesc);
OPT_Links->next = l;
__MOVE(linkname, OPT_Links->name, 256);
}
OPT_InName((void*)linkname, 256);
}
}
static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
@ -1068,6 +1121,13 @@ static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par)
tag = OPM_SymRInt();
last = NIL;
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->mnolev = -mno;
if (last == NIL) {
@ -1186,7 +1246,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
*typ = OPT_NewStr(0, 1);
} else {
__COPY(name, obj->name, 256);
__MOVE(name, obj->name, 256);
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
@ -1216,7 +1276,7 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0;
tag = OPM_SymRInt();
if (tag == 35) {
(*typ)->sysflag = (INT16)OPM_SymRInt();
(*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768);
tag = OPM_SymRInt();
}
switch (tag) {
@ -1346,7 +1406,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPT_Struct typ = NIL;
INT32 tag;
OPT_ConstExt ext = NIL;
OPS_Name commentText;
BOOLEAN hasComment;
INT16 j;
INT32 len;
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) {
OPT_InStruct(&typ);
obj = typ->strobj;
@ -1362,7 +1452,7 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->conval = OPT_NewConst();
OPT_InConstant(tag, obj->conval);
obj->typ = OPT_InTyp(tag);
} else if (tag >= 31) {
} else if ((tag >= 31 && tag <= 33)) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link);
@ -1377,8 +1467,8 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->mode = 9;
ext = OPT_NewExt();
obj->conval->ext = ext;
s = (INT16)OPM_SymRInt();
(*ext)[0] = (CHAR)s;
s = __SHORTF(OPM_SymRInt(), 32768);
(*ext)[0] = __CHR(s);
i = 1;
while (i <= s) {
OPM_SymRCh(&(*ext)[__X(i, 256)]);
@ -1389,20 +1479,37 @@ static OPT_Object OPT_InObj (INT8 mno)
OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32);
OPM_LogWNum(tag, 0);
OPM_LogWLn();
OPM_err(155);
return NIL;
break;
}
} else if (tag == 20) {
obj->mode = 5;
OPT_InStruct(&obj->typ);
} else {
} else if (tag == 21 || tag == 22) {
obj->mode = 1;
if (tag == 22) {
obj->vis = 2;
}
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);
}
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);
if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) {
OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255);
@ -1458,9 +1565,15 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
OPM_DeleteSym((void*)name, 256);
*done = 0;
} else {
OPM_OldSym((void*)name, 256, &*done);
}
if (*done) {
OPT_InMod(&mno);
OPT_InLinks();
OPT_impCtxt.nextTag = OPM_SymRInt();
while (!OPM_eofSF()) {
obj = OPT_InObj(mno);
@ -1483,7 +1596,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
}
static void OPT_OutName (CHAR *name, LONGINT name__len)
static void OPT_OutName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@ -1507,6 +1620,17 @@ static void OPT_OutMod (INT16 mno)
}
}
static void OPT_OutLinks (void)
{
OPT_Link l = NIL;
l = OPT_Links;
while (l != NIL) {
OPT_OutName((void*)l->name, 256);
l = l->next;
}
OPM_SymWCh(0x00);
}
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
INT32 i, j, n;
@ -1700,7 +1824,7 @@ static void OPT_OutConstant (OPT_Object obj)
OPM_SymWInt(f);
switch (f) {
case 2: case 3:
OPM_SymWCh((CHAR)obj->conval->intval);
OPM_SymWCh(__CHR(obj->conval->intval));
break;
case 4:
OPM_SymWInt(obj->conval->intval);
@ -1728,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)
{
INT16 i, j;
OPT_ConstExt ext = NIL;
INT16 k, l;
if (obj != NIL) {
OPT_OutObj(obj->left);
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) {
OPT_FPrintErr(obj, 250);
} else if (obj->vis != 0) {
@ -1833,6 +1984,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
if (OPM_noerr) {
OPM_SymWInt(16);
OPT_OutName((void*)OPT_SelfName, 256);
OPT_OutLinks();
OPT_expCtxt.reffp = 0;
OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
@ -1854,7 +2006,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_newsf = 0;
OPT_symNew = 0;
if (!OPM_noerr || OPT_findpc) {
OPM_DeleteNewSym();
OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@ -1969,10 +2121,11 @@ static void EnumPtrs(void (*P)(void*))
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 5184, 1, P);
P(OPT_Links);
}
__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_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,
@ -2008,6 +2161,7 @@ __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 5184), {16, 24, 32, 40, 48,
3856, 3864, 3872, 3880, 3888, 3896, 3904, 3912, 3920, 3928, 3936, 3944, 3952, 3960, 3968, 3976,
3984, 3992, 4000, 4008, 4016, 4024, 4032, 4040, 4048, 4056, 4064, 4072, 4080, 4088, -4088}};
__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-8}};
__TDESC(OPT_LinkDesc, 1, 1) = {__TDFLDS("LinkDesc", 264), {256, -16}};
export void *OPT__init(void)
{
@ -2024,6 +2178,7 @@ export void *OPT__init(void)
__INITYP(OPT_NodeDesc, OPT_NodeDesc, 0);
__INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0);
__INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0);
__INITYP(OPT_LinkDesc, OPT_LinkDesc, 0);
/* BEGIN */
OPT_topScope = NIL;
OPT_OpenScope(0, NIL);

View file

@ -1,4 +1,4 @@
/* voc 1.95 [2016/11/24]. 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
#define OPT__h
@ -21,6 +21,15 @@ typedef
LONGREAL realval;
} OPT_ConstDesc;
typedef
struct OPT_LinkDesc *OPT_Link;
typedef
struct OPT_LinkDesc {
OPS_Name name;
OPT_Link next;
} OPT_LinkDesc;
typedef
struct OPT_NodeDesc *OPT_Node;
@ -52,6 +61,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -75,11 +85,13 @@ import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
import OPT_Link OPT_Links;
import ADDRESS *OPT_ConstDesc__typ;
import ADDRESS *OPT_ObjDesc__typ;
import ADDRESS *OPT_StrDesc__typ;
import ADDRESS *OPT_NodeDesc__typ;
import ADDRESS *OPT_LinkDesc__typ;
import void OPT_Align (INT32 *adr, INT32 base);
import INT32 OPT_BaseAlignment (OPT_Struct typ);

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