ftpd: Add help command

This option disables runtime checks to reduce binary file size.

Signed-off-by: Max Logaev <maxlogaev@proton.me>

.gitea/workflows/build.yaml

@@ -29,6 +29,7 @@ jobs:
       - name: Checkout
         uses: actions/checkout@v4
         with:
+          submodules: true
           fetch-depth: 0
 
       - name: Get describe

.gitmodules

@@ -0,0 +1,3 @@
+[submodule "programs/develop/oberon07"]
+	path = programs/develop/oberon07
+	url = https://github.com/AntKrotov/oberon-07-compiler.git

data/Tupfile.lua

@@ -176,10 +176,15 @@ extra_files = {
  {"kolibrios/develop/c--/manual_c--.htm", SRC_PROGS .. "/cmm/c--/manual_c--.htm"},
  {"kolibrios/develop/fpc/", "common/develop/fpc/*"},
  {"kolibrios/develop/fpc/examples/", "../programs/develop/fp/examples/src/*"},
- {"kolibrios/develop/oberon07/", "../programs/develop/oberon07/*"},
- {"kolibrios/develop/oberon07/doc/", "../programs/develop/oberon07/doc/*"},
- {"kolibrios/develop/oberon07/lib/KolibriOS/", "../programs/develop/oberon07/lib/KolibriOS/*"},
- {"kolibrios/develop/oberon07/samples/", SRC_PROGS .. "/develop/oberon07/samples/*"},
+ {"kolibrios/develop/oberon07/compiler.kex", SRC_PROGS .. "/develop/oberon07/Compiler.kex"},
+ {"kolibrios/develop/oberon07/LICENSE", SRC_PROGS .. "/develop/oberon07/LICENSE"},
+ {"kolibrios/develop/oberon07/doc/CC.txt", SRC_PROGS .. "/develop/oberon07/doc/CC.txt"},
+ {"kolibrios/develop/oberon07/doc/KOSLib.txt", SRC_PROGS .. "/develop/oberon07/doc/KOSLib.txt"},
+ {"kolibrios/develop/oberon07/doc/x86.txt", SRC_PROGS .. "/develop/oberon07/doc/x86.txt"},
+ {"kolibrios/develop/oberon07/doc/Oberon07.Report_2016_05_03.pdf", SRC_PROGS .. "/develop/oberon07/doc/Oberon07.Report_2016_05_03.pdf"},
+ {"kolibrios/develop/oberon07/lib/KolibriOS/", SRC_PROGS .. "/develop/oberon07/lib/KolibriOS/*"},
+ {"kolibrios/develop/oberon07/lib/Math/", SRC_PROGS .. "/develop/oberon07/lib/Math/*"},
+ {"kolibrios/develop/oberon07/samples/", SRC_PROGS .. "/develop/oberon07/samples/KolibriOS/*"},
  {"kolibrios/develop/tcc/lib/", SRC_PROGS ..  "/develop/ktcc/trunk/bin/lib/*"},
  {"kolibrios/develop/tcc/include/", SRC_PROGS ..  "/develop/ktcc/trunk/libc.obj/include/*"},
  {"kolibrios/develop/tcc/include/clayer/", SRC_PROGS ..  "/develop/ktcc/trunk/libc.obj/include/clayer/*"},
@@ -467,7 +472,6 @@ tup.append_table(img_files, {
  {"DEMOS/ZEROLINE", VAR_PROGS .. "/demos/zeroline/trunk/zeroline"},
  {"DEVELOP/BOARD", VAR_PROGS .. "/system/board/trunk/board"},
  {"DEVELOP/DBGBOARD", VAR_PROGS .. "/system/dbgboard/dbgboard"},
- {"DEVELOP/CEDIT", SRC_PROGS .. "/develop/cedit/CEDIT"},
  {"DEVELOP/CHARSETS", VAR_PROGS .. "/develop/charsets/charsets"},
  {"DEVELOP/COBJ", VAR_PROGS .. "/develop/cObj/trunk/cObj"},
  {"DEVELOP/ENTROPYV", VAR_PROGS .. "/develop/entropyview/entropyview"},
@@ -722,6 +726,7 @@ tup.append_table(img_files, {
  {"SHELL", VAR_PROGS .. "/system/shell/shell"},
  {"GAMES/DINO", VAR_PROGS .. "/games/dino/dino"},
  {"GAMES/FLPYBIRD", VAR_PROGS .. "/games/flpybird/flpybird"},
+ {"LIB/LIBC.OBJ", VAR_PROGS .. "/develop/ktcc/trunk/libc.obj/source/libc.obj"},
 })
 tup.append_table(extra_files, {
  {"kolibrios/utils/thashview", VAR_PROGS .. "/other/TinyHashView/thashview"},
@@ -740,12 +745,18 @@ tup.append_table(extra_files, {
 })
 end -- tup.getconfig('NO_TCC') ~= 'full'
 
+-- Programs that require oberon07 compiler.
+if tup.getconfig('NO_OB07') ~= 'full' then
+tup.append_table(img_files, {
+ {"DEVELOP/CEDIT", VAR_PROGS .. "/develop/cedit/cedit"},
+})
+end -- tup.getconfig('NO_OB07') ~= 'full'
+
 -- Programs that require GCC to compile.
 if tup.getconfig('NO_GCC') ~= 'full' then
 tup.append_table(img_files, {
  {"GAMES/REVERSI", VAR_PROGS .. "/games/reversi/reversi"},
  {"LIB/BASE64.OBJ", VAR_PROGS .. "/develop/libraries/base64/base64.obj"},
- {"LIB/LIBC.OBJ", VAR_PROGS .. "/develop/ktcc/trunk/libc.obj/source/libc.obj"},
  {"LIB/ICONV.OBJ", VAR_PROGS .. "/develop/libraries/iconv/iconv.obj"},
  -- {"LIB/MTAR.OBJ", VAR_PROGS .. "/develop/libraries/microtar/mtar.obj"},
 })

programs/develop/cedit/SHORTCUT.TXT

@@ -47,3 +47,9 @@
   перемещение по тексту:
   (ctrl+)Home, (ctrl+)End, (ctrl+)PageUp, (ctrl+)PageDown
   ctrl+Left, ctrl+Right
+
+  перемещение в панели поиска:
+  Tab         к следующему полю ввода
+  Shift-Tab   к предыдущему полю ввода
+  Enter       поиск следующего вхождения
+

programs/develop/cedit/SRC/CEdit.ob07

@@ -28,7 +28,7 @@ IMPORT
     RW, Ini, EB := EditBox, Tabs, Toolbar, SB := StatusBar;
 
 CONST
-    HEADER = "CEdit (30-apr-2025)";
+    HEADER = "CEdit (11-jan-2026)";
 
     ShellFilter = "";
     EditFilter = "sh|inc|txt|asm|ob07|c|cpp|h|pas|pp|lua|ini|json";
@@ -1750,7 +1750,15 @@ BEGIN
         ELSE
             IF EditBox_Focus(FindEdit) THEN
             	IF keyCode = 15 THEN (* Tab *)
-            		SetFocus(ReplaceEdit, TRUE)
+                    IF shift THEN
+            		    SetFocus(GotoEdit, TRUE)
+                    ELSE
+                        SetFocus(ReplaceEdit, TRUE)
+                    END
+                ELSIF keyCode = 28 THEN (* Enter *)    
+                    IF searchOpened & (searchText # "") THEN
+                        notFound := ~T.findNext(text, BKW.value)
+                    END
             	ELSE
 	                EB.key(FindEdit, key);
 	                EditBox_Get(FindEdit, new_searchText);
@@ -1761,14 +1769,26 @@ BEGIN
                 END
             ELSIF EditBox_Focus(ReplaceEdit) THEN
             	IF keyCode = 15 THEN (* Tab *)
-            		SetFocus(GotoEdit, TRUE)
+                    IF shift THEN
+                        SetFocus(FindEdit, TRUE)
+                    ELSE
+                        SetFocus(GotoEdit, TRUE)
+                    END
+                ELSIF keyCode = 28 THEN (* Enter *)    
+                    IF searchOpened & (searchText # "") THEN
+                        notFound := ~T.findNext(text, BKW.value)
+                    END
             	ELSE
                 	EB.key(ReplaceEdit, key);
                 	EditBox_Get(ReplaceEdit, replaceText)
                 END
             ELSIF EditBox_Focus(GotoEdit) THEN
             	IF keyCode = 15 THEN (* Tab *)
-            		SetFocus(FindEdit, TRUE)
+                    IF shift THEN
+                        SetFocus(ReplaceEdit, TRUE)
+                    ELSE
+                        SetFocus(FindEdit, TRUE)
+                    END
             	ELSE
 	                IF (key DIV 256) MOD 256 = 13 THEN
 	                    goto

programs/develop/cedit/Tupfile.lua

@@ -0,0 +1,9 @@
+if tup.getconfig("NO_OB07") ~= "" then return end
+if tup.getconfig("HELPERDIR") == ""
+then
+  HELPERDIR = "../../"
+end
+
+tup.include(HELPERDIR .. "/use_ob07.lua")
+
+build_ob07({"SRC/CEdit.ob07"}, "cedit"); 

programs/develop/ktcc/trunk/libc.obj/source/libc.c

@@ -204,6 +204,7 @@ ksys_dll_t EXPORTS[] = {
     { "strstr", &strstr },
     { "strtok", &strtok },
     { "strxfrm", &strxfrm },
+    { "strpbrk", &strpbrk },
     { "__errno", &__errno },
     { "closedir", &closedir },
     { "opendir", &opendir },

programs/develop/mtdbg/gui.inc

@@ -122,7 +122,13 @@ struc fpcvt
   .sizeof:
 }
 
+;-----------------------------------------------------------------------------
+;                         Command flags
 
+CMD_WITHOUT_PARAM       = 1b    ; command may be called without parameters
+CMD_WITH_PARAM          = 10b   ; command may be called with parameters
+CMD_WITHOUT_LOADED_APP  = 100b  ; command may be called without loaded program
+CMD_WITH_LOADED_APP     = 1000b ; command may be called with loaded program
 
 ;-----------------------------------------------------------------------------
 ;                          Entry point
@@ -449,63 +455,56 @@ z1:
         mov     esi, commands
         call    find_cmd
         mov     eax, aUnknownCommand
-        jc      .x11
-
-        ; check command requirements
-        ; flags field:
-        ; &1: command may be called without parameters
-        ; &2: command may be called with parameters
-        ; &4: command may be called without loaded program
-        ; &8: command may be called with loaded program
+        jc      .cmd_procg
         mov     eax, [esi+8]
         mov     ecx, [curarg]
         cmp     byte [ecx], 0
         jz      .noargs
-        test    byte [esi+16], 2
-        jz      .x11
+        test    byte [esi+16], CMD_WITH_PARAM
+        jz      .cmd_procg
         jmp     @f
 
     .noargs:
-        test    byte [esi+16], 1
-        jz      .x11
+        test    byte [esi+16], CMD_WITHOUT_PARAM
+        jz      .cmd_procg
 
     @@:
         cmp     [debuggee_pid], 0
         jz      .nodebuggee
         mov     eax, aAlreadyLoaded
-        test    byte [esi+16], 8
-        jz      .x11
-        jmp     .x9
+        test    byte [esi+16], CMD_WITH_LOADED_APP
+        jz      .cmd_procg
+        jmp     .run_cmd
 
     .nodebuggee:
         mov     eax, need_debuggee
-        test    byte [esi+16], 4
-        jnz     .x9
+        test    byte [esi+16], CMD_WITHOUT_LOADED_APP
+        jnz     .run_cmd
 
-    .x11:
+    .cmd_procg:
         xchg    esi, eax
         call    put_message
 
         ; store cmdline for repeating
-    .x10:
+    .cmd_procg_no_put_msg:
         mov     esi, cmdline
         mov     ecx, [cmdline_len]
 
     @@:
         cmp     ecx, 0
-        jle     .we
+        jle     .wait_event
         mov     al, [esi + ecx]
         mov     [cmdline_prev + ecx], al
         dec     ecx
         jmp     @b
 
-    .we:
+    .wait_event:
         mov     [cmdline_len], 0
         jmp     waitevent
 
-    .x9:
+    .run_cmd:
         call    dword [esi+4]
-        jmp     .x10
+        jmp     .cmd_procg_no_put_msg
 
 ;-----------------------------------------------------------------------------
 ;                            Cmdline handling

programs/develop/mtdbg/mtdbg.asm

@@ -2,7 +2,10 @@
 COLOR_THEME fix MOVIEOS
 
 format binary as ""
+
 include '../../macros.inc'
+include '../../KOSfuncs.inc'
+
 use32
         db      'MENUET01'
         dd      1
@@ -1145,6 +1148,105 @@ OnDump:
     .ret:
         ret
 
+;-----------------------------------------------------------------------------
+;                            Print Backtrace
+
+struct STACK_FRAME
+        prev_frame      rd 1
+        ret_addr        rd 1
+ends
+
+OnBacktrace:
+        push    ebp
+
+        ; Set max depth counter
+        xor     eax, eax
+        dec     eax
+
+        mov     esi, [curarg]
+        cmp     byte [esi], 0
+        jz      .save_depth
+
+        call    get_hex_number
+        mov     esi, aParseError
+        jc      .exit
+
+        ; If depth 0
+        test    eax, eax
+        jz      .done
+
+    .save_depth:
+        mov     [bt_depth], eax
+
+        ; Get start frame addres
+        mov     ebp, [_ebp]
+        test    ebp, ebp
+        jz      .done
+
+        mov     edi, stack_frame_dump
+
+    .next:
+        mcall   SF_DEBUG, SSF_READ_MEMORY, [debuggee_pid], sizeof.STACK_FRAME, ebp
+        cmp     eax, -1
+        mov     esi, read_mem_err
+        jz      .exit
+
+        ; The address of the previous frame must be less than the current one
+        mov     eax, [edi + STACK_FRAME.prev_frame]
+        test    eax, eax
+        jz      .done
+
+        ; Save stack_frame_dump
+        push    edi
+        ; Save previous frame
+        push    ebp
+        ; Save return address
+        mov     eax, [edi + STACK_FRAME.ret_addr]
+        push    eax
+
+        ; Print frame address and return address
+        push    eax         ; pop in put_message_nodraw
+        push    ebp         ; pop in put_message_nodraw
+        mov     esi, aBacktraceFmt
+        call    put_message_nodraw
+
+        ; Restore return address
+        pop     eax
+
+        ; Find symbol by return address
+        call    find_near_symbol
+        test    esi, esi
+        jnz     .print_sym
+
+        mov     esi, aBacktraceSymStub
+
+    .print_sym:
+        call    put_message_nodraw
+        mov     esi, newline
+        call    put_message_nodraw
+
+        ; Restore previous frame
+        pop     ebp
+        ; Restore stack_frame_dump
+        pop     edi
+
+        ; The address of the previous frame must be greater than the current one.
+        cmp     [edi + STACK_FRAME.prev_frame], ebp
+        jna     .done
+
+        ; Set previous frame
+        mov     ebp,  [edi + STACK_FRAME.prev_frame]
+        dec     [bt_depth]
+        jnz     .next
+
+    .done:
+        mov     esi, newline
+
+    .exit:
+        call    put_message
+        pop     ebp
+        ret
+
 ;-----------------------------------------------------------------------------
 ;                   Dissassemble block of executable event
 
@@ -1864,7 +1966,7 @@ include 'disasm.inc'
 
 caption_str db  'Kolibri Debugger',0
 
-begin_str db    'Kolibri Debugger, version 0.35',10
+begin_str db    'Kolibri Debugger, version 0.36',10
         db      'Hint: type "help" for help, "quit" to quit'
 newline db      10,0
 prompt  db      '> ',0
@@ -1880,66 +1982,88 @@ help_groups:
 ;-----------------------------------------------------------------------------
 ;                   Commands format definitions
 
-; TODO: make it with macros
-
-; flags field:
-; &1: command may be called without parameters
-; &2: command may be called with parameters
-; &4: command may be called without loaded program
-; &8: command may be called with loaded program
 commands:
         dd      _aH, OnHelp, HelpSyntax, HelpHelp
-        db      0Fh
+        db      CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITHOUT_LOADED_APP or CMD_WITH_LOADED_APP
+
         dd      aHelp, OnHelp, HelpSyntax, HelpHelp
-        db      0Fh
+        db      CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITHOUT_LOADED_APP or CMD_WITH_LOADED_APP
+
         dd      aQuit, OnQuit, QuitSyntax, QuitHelp
-        db      0Dh
+        db      CMD_WITHOUT_PARAM or CMD_WITHOUT_LOADED_APP or CMD_WITH_LOADED_APP
+
         dd      aLoad, OnLoad, LoadSyntax, LoadHelp
-        db      6
+        db      CMD_WITH_PARAM or CMD_WITHOUT_LOADED_APP
+    
         dd      aReload, OnReload, ReloadSyntax, ReloadHelp
-        db      0Dh
+        db      CMD_WITHOUT_PARAM or CMD_WITHOUT_LOADED_APP or CMD_WITH_LOADED_APP
+
         dd      aTerminate, OnTerminate, TerminateSyntax, TerminateHelp
-        db      9
+        db      CMD_WITHOUT_PARAM or CMD_WITH_LOADED_APP
+
         dd      aDetach, OnDetach, DetachSyntax, DetachHelp
-        db      9
+        db      CMD_WITHOUT_PARAM or CMD_WITH_LOADED_APP
+
         dd      aSuspend, OnSuspend, SuspendSyntax, SuspendHelp
-        db      9
+        db      CMD_WITHOUT_PARAM or CMD_WITH_LOADED_APP
+
         dd      aResume, OnResume, ResumeSyntax, ResumeHelp
-        db      0Bh
+        db      CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aStep, OnStepMultiple, StepSyntax, StepHelp
-        db      0Bh
+        db      CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+    
         dd      aProceed, OnProceedMultiple, ProceedSyntax, ProceedHelp
-        db      0Bh
+        db      CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aCalc, OnCalc, CalcSyntax, CalcHelp
-        db      0Eh
+        db      CMD_WITH_PARAM or CMD_WITHOUT_LOADED_APP or CMD_WITH_LOADED_APP
+
         dd      aDump, OnDump, DumpSyntax, DumpHelp
-        db      0Bh
+        db      CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
+        dd      aBacktrace, OnBacktrace, BacktraceSyntax, BacktraceHelp
+        db      CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aUnassemble, OnUnassemble, UnassembleSyntax, UnassembleHelp
-        db      0Bh
+        db      CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aBp, OnBp, BpSyntax, BpHelp
-        db      0Ah
+        db      CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aBpm, OnBpmb, BpmSyntax, BpmHelp
-        db      0Ah
+        db      CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aBpmb, OnBpmb, BpmSyntax, BpmHelp
-        db      0Ah
+        db      CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aBpmw, OnBpmw, BpmSyntax, BpmHelp
-        db      0Ah
+        db      CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aBpmd, OnBpmd, BpmSyntax, BpmHelp
-        db      0Ah
+        db      CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aBl, OnBl, BlSyntax, BlHelp
-        db      0Bh
+        db      CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aBc, OnBc, BcSyntax, BcHelp
-        db      0Ah
+        db      CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aBd, OnBd, BdSyntax, BdHelp
-        db      0Ah
+        db      CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aBe, OnBe, BeSyntax, BeHelp
-        db      0Ah
+        db      CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aReg, OnReg, RSyntax, RHelp
-        db      0Ah
+        db      CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      aUnpack, OnUnpack, UnpackSyntax, UnpackHelp
-        db      9
+        db      CMD_WITHOUT_PARAM or CMD_WITH_LOADED_APP
+
         dd      aLoadSymbols, OnLoadSymbols, LoadSymbolsSyntax, LoadSymbolsHelp
-        db      0Ah
+        db      CMD_WITH_PARAM or CMD_WITH_LOADED_APP
+
         dd      0
 
 ;-----------------------------------------------------------------------------
@@ -1980,7 +2104,8 @@ help_data_msg db        'List of data commands:',10
         db      'd [<expression>]     - dump data at given address',10
         db      'u [<expression>]     - unassemble instructions at given address',10
         db      'r <register> <expression> or',10
-        db      'r <register>=<expression> - set register value',10,0
+        db      'r <register>=<expression> - set register value',10
+        db      'bt [<number>]        - display backtrace / stacktrace',10,0
 
 ;               Breakpoints commands group
 
@@ -2038,6 +2163,11 @@ DumpHelp db     'Dump data of debugged program',10
 DumpSyntax db   'Usage: d <expression> - dump data at specified address',10
         db      '   or: d              - continue current dump',10,0
 
+aBacktrace      db  3,'bt',0
+BacktraceHelp   db 'Display backtrace / stacktrace',10
+BacktraceSyntax db 'Usage: bt <number> - display backtrace with depth',10
+                db '   or: bt            display all backtrace',10,0
+
 aCalc   db      2,'?',0
 CalcHelp db     'Calculate value of expression',10
 CalcSyntax db   'Usage: ? <expression>',10,0
@@ -2102,6 +2232,11 @@ LoadSymbolsSyntax db 'Usage: load-symbols <symbols-file-name>',10,0
 
 aUnknownCommand db 'Unknown command',10,0
 
+;-----------------------------------------------------------------------------
+;                             Info messages
+aBacktraceSymStub  db '??',0
+aBacktraceFmt      db '[0x%8X] 0x%8X in ',0
+
 ;-----------------------------------------------------------------------------
 ;                             Error messages
 
@@ -2474,11 +2609,13 @@ disasm_cur_pos          dd ?
 disasm_cur_str          dd ?
 disasm_string           rb 256
 
-thread_info             process_information
+stack_frame_dump        rb sizeof.STACK_FRAME
+bt_depth                rd 1
 
 ;-----------------------------------------------------------------------------
 ;                  Coordinates and sizes for GUI
 
+thread_info             process_information
 data_x_size_dd          dd ?, ?
 messages_x_size_dd      dd ?, ?
 registers_x_pos_dd      dd ?, ?

programs/develop/mtdbg/symbols.inc

@@ -4,6 +4,11 @@
 
 include 'sort.inc'
 
+struct DEBUG_SYMBOL
+        addr    rd 1
+        string  rd 0
+ends
+
 ; compare proc for sorter
 compare:
         cmpsd
@@ -459,4 +464,69 @@ find_symbol_name:
 
   @@:
         pop     esi
-        ret
+        ret
+
+;-----------------------------------------------------------------------------
+;   
+; Find the nearest symol using binary search
+;
+; in:  eax - target addres
+; out: esi - symbol name
+; destroys: ebx, ecx, edx, edi, ebp
+;
+find_near_symbol:
+        mov     edi, [symbols] 
+        
+        xor     esi, esi            ; Result
+        mov     ecx, esi            ; Left
+        mov     edx, [num_symbols]  ; Right
+        dec     edx
+        js      .end       
+
+        ; If the first address is already greater than the target
+        mov     ebp, [edi + ecx * sizeof.DEBUG_SYMBOL]
+        cmp     [ebp + DEBUG_SYMBOL.addr], eax
+        ja      .end
+
+        ; If the last address is less than or equal to the target
+        mov     ebp, [edi + edx * sizeof.DEBUG_SYMBOL]
+        cmp     [ebp + DEBUG_SYMBOL.addr], eax
+        jbe     .found
+
+    .loop:
+        cmp     ecx, edx
+        ja      .end
+
+        ; Calc middle:
+        mov     ebx, edx            ; Middle
+        sub     ebx, ecx            ; (right - left)
+        shr     ebx, 1              ;  / 2
+        add     ebx, ecx            ; + left
+
+        ; Equal
+        mov     ebp, [edi + ebx * sizeof.DEBUG_SYMBOL]
+        cmp     [ebp + DEBUG_SYMBOL.addr], eax
+        jz      .found
+        jb      .update_left
+
+        ; Update right
+        mov     edx, ebx
+        dec     edx
+        jmp     .loop
+
+    .update_left:
+        ; Save potential result
+        mov     esi, ebp
+        add     esi, DEBUG_SYMBOL.string
+
+        ; Update left
+        mov     ecx, ebx
+        inc     ecx
+        jmp     .loop
+
+    .found:
+        mov     esi, ebp
+        add     esi, DEBUG_SYMBOL.string
+
+    .end:
+        ret

programs/develop/oberon07/LICENSE

@@ -1,25 +0,0 @@
-BSD 2-Clause License
-
-Copyright (c) 2018-2023, Anton Krotov
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-* Redistributions of source code must retain the above copyright notice, this
-  list of conditions and the following disclaimer.
-
-* Redistributions in binary form must reproduce the above copyright notice,
-  this list of conditions and the following disclaimer in the documentation
-  and/or other materials provided with the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

programs/develop/oberon07/doc/CC.txt

@@ -1,61 +0,0 @@
-Условная компиляция
-
-синтаксис:
-
-    $IF "(" ident {"|" ident} ")"
-        <...>
-    {$ELSIF "(" ident {"|" ident} ")"}
-        <...>
-    [$ELSE]
-        <...>
-    $END
-
-    где ident:
-    - одно из возможных значений параметра <target> в командной строке
-    - пользовательский идентификатор, переданный с ключом -def при компиляции
-    - один из возможных предопределенных идентификаторов:
-
-        WINDOWS   - приложение Windows
-        LINUX     - приложение Linux
-        KOLIBRIOS - приложение KolibriOS
-        CPU_X86   - приложение для процессора x86 (32-бит)
-        CPU_X8664 - приложение для процессора x86_64
-
-
-примеры:
-
-    $IF (win64con | win64gui | win64dll)
-        OS := "WIN64";
-    $ELSIF (win32con | win32gui | win32dll)
-        OS := "WIN32";
-    $ELSIF (linux64exe | linux64so)
-        OS := "LINUX64";
-    $ELSIF (linux32exe | linux32so)
-        OS := "LINUX32";
-    $ELSE
-        OS := "UNKNOWN";
-    $END
-
-
-    $IF (debug) (* -def debug *)
-        print("debug");
-    $END
-
-
-    $IF (WINDOWS)
-        $IF (CPU_X86)
-        (*windows 32*)
-
-        $ELSIF (CPU_X8664)
-        (*windows 64*)
-
-        $END
-    $ELSIF (LINUX)
-        $IF (CPU_X86)
-        (*linux 32*)
-
-        $ELSIF (CPU_X8664)
-        (*linux 64*)
-
-        $END
-    $END

programs/develop/oberon07/doc/KOSLib.txt

@@ -1,566 +0,0 @@
-==============================================================================
-
-        Библиотека (KolibriOS)
-
-------------------------------------------------------------------------------
-MODULE Out - консольный вывод
-
-        PROCEDURE Open
-                формально открывает консольный вывод
-
-        PROCEDURE Int(x, width: INTEGER)
-                вывод целого числа x;
-                width - количество знакомест, используемых для вывода
-
-        PROCEDURE Real(x: REAL; width: INTEGER)
-                вывод вещественного числа x в плавающем формате;
-                width - количество знакомест, используемых для вывода
-
-        PROCEDURE Char(x: CHAR)
-                вывод символа x
-
-        PROCEDURE FixReal(x: REAL; width, p: INTEGER)
-                вывод вещественного числа x в фиксированном формате;
-                width - количество знакомест, используемых для вывода;
-                p - количество знаков после десятичной точки
-
-        PROCEDURE Ln
-                переход на следующую строку
-
-        PROCEDURE String(s: ARRAY OF CHAR)
-                вывод строки s
-
-------------------------------------------------------------------------------
-MODULE In - консольный ввод
-
-        VAR Done: BOOLEAN
-                принимает значение TRUE в случае успешного выполнения
-                операции ввода, иначе FALSE
-
-        PROCEDURE Open
-                формально открывает консольный ввод,
-                также присваивает переменной Done значение TRUE
-
-        PROCEDURE Int(VAR x: INTEGER)
-                ввод числа типа INTEGER
-
-        PROCEDURE Char(VAR x: CHAR)
-                ввод символа
-
-        PROCEDURE Real(VAR x: REAL)
-                ввод числа типа REAL
-
-        PROCEDURE String(VAR s: ARRAY OF CHAR)
-                ввод строки
-
-        PROCEDURE Ln
-                ожидание нажатия ENTER
-
-------------------------------------------------------------------------------
-MODULE Console - дополнительные процедуры консольного вывода
-
-        CONST
-
-        Следующие константы определяют цвет консольного вывода
-
-                Black = 0      Blue = 1           Green = 2
-                Cyan = 3       Red = 4            Magenta = 5
-                Brown = 6      LightGray = 7      DarkGray = 8
-                LightBlue = 9  LightGreen = 10    LightCyan = 11
-                LightRed = 12  LightMagenta = 13  Yellow = 14
-                White = 15
-
-        PROCEDURE Cls
-                очистка окна консоли
-
-        PROCEDURE SetColor(FColor, BColor: INTEGER)
-                установка цвета консольного вывода: FColor - цвет текста,
-                BColor - цвет фона, возможные значения - вышеперечисленные
-                константы
-
-        PROCEDURE SetCursor(x, y: INTEGER)
-                установка курсора консоли в позицию (x, y)
-
-        PROCEDURE GetCursor(VAR x, y: INTEGER)
-                записывает в параметры текущие координаты курсора консоли
-
-        PROCEDURE GetCursorX(): INTEGER
-                возвращает текущую x-координату курсора консоли
-
-        PROCEDURE GetCursorY(): INTEGER
-                возвращает текущую y-координату курсора консоли
-
-------------------------------------------------------------------------------
-MODULE ConsoleLib - обертка библиотеки console.obj
-
-------------------------------------------------------------------------------
-MODULE Math - математические функции
-
-        CONST
-
-                pi = 3.141592653589793E+00
-                e  = 2.718281828459045E+00
-
-
-        PROCEDURE IsNan(x: REAL): BOOLEAN
-                возвращает TRUE, если x - не число
-
-        PROCEDURE IsInf(x: REAL): BOOLEAN
-                возвращает TRUE, если x - бесконечность
-
-        PROCEDURE sqrt(x: REAL): REAL
-                квадратный корень x
-
-        PROCEDURE exp(x: REAL): REAL
-                экспонента x
-
-        PROCEDURE ln(x: REAL): REAL
-                натуральный логарифм x
-
-        PROCEDURE sin(x: REAL): REAL
-                синус x
-
-        PROCEDURE cos(x: REAL): REAL
-                косинус x
-
-        PROCEDURE tan(x: REAL): REAL
-                тангенс x
-
-        PROCEDURE arcsin(x: REAL): REAL
-                арксинус x
-
-        PROCEDURE arccos(x: REAL): REAL
-                арккосинус x
-
-        PROCEDURE arctan(x: REAL): REAL
-                арктангенс x
-
-        PROCEDURE arctan2(y, x: REAL): REAL
-                арктангенс y/x
-
-        PROCEDURE power(base, exponent: REAL): REAL
-                возведение числа base в степень exponent
-
-        PROCEDURE log(base, x: REAL): REAL
-                логарифм x по основанию base
-
-        PROCEDURE sinh(x: REAL): REAL
-                гиперболический синус x
-
-        PROCEDURE cosh(x: REAL): REAL
-                гиперболический косинус x
-
-        PROCEDURE tanh(x: REAL): REAL
-                гиперболический тангенс x
-
-        PROCEDURE arsinh(x: REAL): REAL
-                обратный гиперболический синус x
-
-        PROCEDURE arcosh(x: REAL): REAL
-                обратный гиперболический косинус x
-
-        PROCEDURE artanh(x: REAL): REAL
-                обратный гиперболический тангенс x
-
-        PROCEDURE round(x: REAL): REAL
-                округление x до ближайшего целого
-
-        PROCEDURE frac(x: REAL): REAL;
-                дробная часть числа x
-
-        PROCEDURE floor(x: REAL): REAL
-                наибольшее целое число (представление как REAL),
-                не больше x: floor(1.2) = 1.0
-
-        PROCEDURE ceil(x: REAL): REAL
-                наименьшее целое число (представление как REAL),
-                не меньше x: ceil(1.2) = 2.0
-
-        PROCEDURE sgn(x: REAL): INTEGER
-                если x > 0 возвращает 1
-                если x < 0 возвращает -1
-                если x = 0 возвращает 0
-
-        PROCEDURE fact(n: INTEGER): REAL
-                факториал n
-
-------------------------------------------------------------------------------
-MODULE Debug - вывод на доску отладки
-        Интерфейс как модуль Out
-
-        PROCEDURE Open
-                открывает доску отладки
-
-------------------------------------------------------------------------------
-MODULE File - работа с файловой системой
-
-        TYPE
-
-                FNAME = ARRAY 520 OF CHAR
-
-                FS = POINTER TO rFS
-
-                rFS = RECORD (* информационная структура файла *)
-                        subfunc, pos, hpos, bytes, buffer: INTEGER;
-                        name: FNAME
-                END
-
-                FD = POINTER TO rFD
-
-                rFD = RECORD (* структура блока данных входа каталога *)
-                        attr: INTEGER;
-                        ntyp: CHAR;
-                        reserved: ARRAY 3 OF CHAR;
-                        time_create, date_create,
-                        time_access, date_access,
-                        time_modif,  date_modif,
-                        size, hsize: INTEGER;
-                        name: FNAME
-                END
-
-        CONST
-
-                SEEK_BEG = 0
-                SEEK_CUR = 1
-                SEEK_END = 2
-
-        PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
-                Загружает в память файл с именем FName, записывает в параметр
-                size размер файла, возвращает адрес загруженного файла
-                или 0 (ошибка). При необходимости, распаковывает
-                файл (kunpack).
-
-        PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN
-                Записывает структуру блока данных входа каталога для файла
-                или папки с именем FName в параметр Info.
-                При ошибке возвращает FALSE.
-
-        PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN
-                возвращает TRUE, если файл с именем FName существует
-
-        PROCEDURE Close(VAR F: FS)
-                освобождает память, выделенную для информационной структуры
-                файла F и присваивает F значение NIL
-
-        PROCEDURE Open(FName: ARRAY OF CHAR): FS
-                возвращает указатель на информационную структуру файла с
-                именем FName, при ошибке возвращает NIL
-
-        PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN
-                удаляет файл с именем FName, при ошибке возвращает FALSE
-
-        PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER
-                устанавливает позицию чтения-записи файла F на Offset,
-                относительно Origin = (SEEK_BEG - начало файла,
-                SEEK_CUR - текущая позиция, SEEK_END - конец файла),
-                возвращает позицию относительно начала файла, например:
-                        Seek(F, 0, SEEK_END)
-                устанавливает позицию на конец файла и возвращает длину
-                файла; при ошибке возвращает -1
-
-        PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER
-                Читает данные из файла в память. F - указатель на
-                информационную структуру файла, Buffer - адрес области
-                памяти, Count - количество байт, которое требуется прочитать
-                из файла; возвращает количество байт, которое было прочитано
-                и соответствующим образом изменяет позицию чтения/записи в
-                информационной структуре F.
-
-        PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER
-                Записывает данные из памяти в файл. F - указатель на
-                информационную структуру файла, Buffer - адрес области
-                памяти, Count - количество байт, которое требуется записать
-                в файл; возвращает количество байт, которое было записано и
-                соответствующим образом изменяет позицию чтения/записи в
-                информационной структуре F.
-
-        PROCEDURE Create(FName: ARRAY OF CHAR): FS
-                создает новый файл с именем FName (полное имя), возвращает
-                указатель на информационную структуру файла,
-                при ошибке возвращает NIL
-
-        PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN
-                создает папку с именем DirName, все промежуточные папки
-                должны существовать, при ошибке возвращает FALSE
-
-        PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN
-                удаляет пустую папку с именем DirName,
-                при ошибке возвращает FALSE
-
-        PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN
-                возвращает TRUE, если папка с именем DirName существует
-
-------------------------------------------------------------------------------
-MODULE Read - чтение основных типов данных из файла F
-
-        Процедуры возвращают TRUE в случае успешной операции чтения и
-        соответствующим образом изменяют позицию чтения/записи в
-        информационной структуре F
-
-        PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN
-
-        PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN
-
-        PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN
-
-        PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN
-
-        PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN
-
-        PROCEDURE WChar(F: File.FS; VAR x: WCHAR): BOOLEAN
-
-------------------------------------------------------------------------------
-MODULE Write - запись основных типов данных в файл F
-
-        Процедуры возвращают TRUE в случае успешной операции записи и
-        соответствующим образом изменяют позицию чтения/записи в
-        информационной структуре F
-
-        PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN
-
-        PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN
-
-        PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN
-
-        PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN
-
-        PROCEDURE Set(F: File.FS; x: SET): BOOLEAN
-
-        PROCEDURE WChar(F: File.FS; x: WCHAR): BOOLEAN
-
-------------------------------------------------------------------------------
-MODULE DateTime - дата, время
-
-        CONST ERR = -7.0E5
-
-        PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER)
-                записывает в параметры компоненты текущей системной даты и
-                времени
-
-        PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
-                возвращает дату, полученную из компонентов
-                Year, Month, Day, Hour, Min, Sec;
-                при ошибке возвращает константу ERR = -7.0E5
-
-        PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
-                                Hour, Min, Sec: INTEGER): BOOLEAN
-                извлекает компоненты
-                Year, Month, Day, Hour, Min, Sec из даты Date;
-                при ошибке возвращает FALSE
-
-------------------------------------------------------------------------------
-MODULE Args - параметры программы
-
-        VAR argc: INTEGER
-                количество параметров программы, включая имя
-                исполняемого файла
-
-        PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR)
-                записывает в строку s n-й параметр программы,
-                нумерация параметров от 0 до argc - 1,
-                нулевой параметр -- имя исполняемого файла
-
-------------------------------------------------------------------------------
-MODULE KOSAPI
-
-        PROCEDURE sysfunc1(arg1: INTEGER): INTEGER
-        PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER
-        ...
-        PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER
-                Обертки для функций API ядра KolibriOS.
-                arg1 .. arg7 соответствуют регистрам
-                        eax, ebx, ecx, edx, esi, edi, ebp;
-                возвращают значение регистра eax после системного вызова.
-
-        PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER
-                Обертка для функций API ядра KolibriOS.
-                arg1 - регистр eax, arg2 - регистр ebx,
-                res2 - значение регистра ebx после системного вызова;
-                возвращает значение регистра eax после системного вызова.
-
-        PROCEDURE malloc(size: INTEGER): INTEGER
-                Выделяет блок памяти.
-                size - размер блока в байтах,
-                возвращает адрес выделенного блока
-
-        PROCEDURE free(ptr: INTEGER): INTEGER
-                Освобождает ранее выделенный блок памяти с адресом ptr,
-                возвращает 0
-
-        PROCEDURE realloc(ptr, size: INTEGER): INTEGER
-                Перераспределяет блок памяти,
-                ptr - адрес ранее выделенного блока,
-                size - новый размер,
-                возвращает указатель на перераспределенный блок,
-                0 при ошибке
-
-        PROCEDURE GetCommandLine(): INTEGER
-                Возвращает адрес строки параметров
-
-        PROCEDURE GetName(): INTEGER
-                Возвращает адрес строки с именем программы
-
-        PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER
-                Загружает DLL с полным именем name. Возвращает адрес таблицы
-                экспорта. При ошибке возвращает 0.
-
-        PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER
-                name - имя процедуры
-                lib - адрес таблицы экспорта DLL
-                Возвращает адрес процедуры. При ошибке возвращает 0.
-
-------------------------------------------------------------------------------
-MODULE ColorDlg - работа с диалогом "Color Dialog"
-
-        TYPE
-
-                Dialog = POINTER TO RECORD (* структура диалога *)
-                    status: INTEGER   (* состояние диалога:
-                                         0 - пользователь нажал Cancel
-                                         1 - пользователь нажал OK
-                                         2 - диалог открыт       *)
-
-                    color:  INTEGER   (* выбранный цвет *)
-                END
-
-        PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog
-                создать диалог
-                draw_window - процедура перерисовки основного окна
-                (TYPE DRAW_WINDOW = PROCEDURE);
-                процедура возвращает указатель на структуру диалога
-
-        PROCEDURE Show(cd: Dialog)
-                показать диалог
-                cd - указатель на структуру диалога, который был создан ранее
-                процедурой Create
-
-        PROCEDURE Destroy(VAR cd: Dialog)
-                уничтожить диалог
-                cd - указатель на структуру диалога
-
-------------------------------------------------------------------------------
-MODULE OpenDlg - работа с диалогом "Open Dialog"
-
-        TYPE
-
-                Dialog = POINTER TO RECORD (* структура диалога *)
-                    status:   INTEGER  (* состояние диалога:
-                                          0 - пользователь нажал Cancel
-                                          1 - пользователь нажал OK
-                                          2 - диалог открыт       *)
-
-                    FileName: ARRAY 4096 OF CHAR (* имя выбранного файла *)
-                    FilePath: ARRAY 4096 OF CHAR (* полное имя выбранного
-                                                    файла           *)
-                END
-
-        PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path,
-                        filter: ARRAY OF CHAR): Dialog
-                создать диалог
-                draw_window - процедура перерисовки основного окна
-                        (TYPE DRAW_WINDOW = PROCEDURE)
-                type -  тип диалога
-                        0 - открыть
-                        1 - сохранить
-                        2 - выбрать папку
-                def_path - путь по умолчанию, папка def_path будет открыта
-                        при первом запуске диалога
-                filter - в строке записано перечисление расширений файлов,
-                        которые будут показаны в диалоговом окне, расширения
-                        разделяются символом "|", например: "ASM|TXT|INI"
-                процедура возвращает указатель на структуру диалога
-
-        PROCEDURE Show(od: Dialog; Width, Height: INTEGER)
-                показать диалог
-                od - указатель на структуру диалога, который был создан ранее
-                     процедурой Create
-                Width и Height - ширина и высота диалогового окна
-
-        PROCEDURE Destroy(VAR od: Dialog)
-                уничтожить диалог
-                od - указатель на структуру диалога
-
-------------------------------------------------------------------------------
-MODULE kfonts - работа с kf-шрифтами
-
-        CONST
-
-                bold            =   1
-                italic          =   2
-                underline       =   4
-                strike_through  =   8
-                smoothing       =  16
-                bpp32           =  32
-
-        TYPE
-
-                TFont = POINTER TO TFont_desc (* указатель на шрифт *)
-
-        PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont
-                загрузить шрифт из файла
-                file_name   имя kf-файла
-                рез-т:          указатель на шрифт/NIL (ошибка)
-
-        PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN
-                установить размер шрифта
-                Font        указатель на шрифт
-                font_size   размер шрифта
-                рез-т:          TRUE/FALSE (ошибка)
-
-        PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN
-                проверить, есть ли шрифт, заданного размера
-                Font        указатель на шрифт
-                font_size   размер шрифта
-                рез-т:          TRUE/FALSE (шрифта нет)
-
-        PROCEDURE Destroy(VAR Font: TFont)
-                выгрузить шрифт, освободить динамическую память
-                Font        указатель на шрифт
-                Присваивает переменной Font значение NIL
-
-        PROCEDURE TextHeight(Font: TFont): INTEGER
-                получить высоту строки текста
-                Font        указатель на шрифт
-                рез-т:          высота строки текста в пикселях
-
-        PROCEDURE TextWidth(Font: TFont;
-                    str, length, params: INTEGER): INTEGER
-                получить ширину строки текста
-                Font        указатель на шрифт
-                str         адрес строки текста в кодировке Win-1251
-                length      количество символов в строке или -1, если строка
-                            завершается нулем
-                params      параметры-флаги см. ниже
-                рез-т:          ширина строки текста в пикселях
-
-        PROCEDURE TextOut(Font: TFont;
-                    canvas, x, y, str, length, color, params: INTEGER)
-                вывести текст в буфер
-                для вывода буфера в окно, использовать ф.65 или
-                ф.7 (если буфер 24-битный)
-                Font        указатель на шрифт
-                canvas      адрес графического буфера
-                            структура буфера:
-                              Xsize       dd
-                              Ysize       dd
-                              picture     rb  Xsize * Ysize * 4 (32 бита)
-                                              или Xsize * Ysize * 3 (24 бита)
-                x, y        координаты текста относительно левого верхнего
-                            угла буфера
-                str         адрес строки текста в кодировке Win-1251
-                length      количество символов в строке или -1, если строка
-                            завершается нулем
-                color       цвет текста 0x00RRGGBB
-                params      параметры-флаги:
-                               1   жирный
-                               2   курсив
-                               4   подчеркнутый
-                               8   перечеркнутый
-                              16   применить сглаживание
-                              32   вывод в 32-битный буфер
-                            возможно использование флагов в любых сочетаниях
-------------------------------------------------------------------------------
-MODULE RasterWorks - обертка библиотеки Rasterworks.obj
-------------------------------------------------------------------------------
-MODULE libimg - обертка библиотеки libimg.obj
-------------------------------------------------------------------------------

programs/develop/oberon07/doc/x86.txt

@@ -1,423 +0,0 @@
-        Компилятор языка программирования Oberon-07/16 для i486
-                Windows/Linux/KolibriOS.
-------------------------------------------------------------------------------
-
-        Параметры командной строки
-
-  Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или
-UTF-8 с BOM-сигнатурой.
-  Выход - испоняемый файл формата PE32, ELF или MENUET01/MSCOFF.
-  Параметры:
-  1) имя главного модуля
-  2) тип приложения
-      "win32con" - Windows console
-      "win32gui" - Windows GUI
-      "win32dll" - Windows DLL
-      "linux32exe" - Linux ELF-EXEC
-      "linux32so"  - Linux ELF-SO
-      "kosexe" - KolibriOS
-      "kosdll" - KolibriOS DLL
-
-  3) необязательные параметры-ключи
-      -out <file_name> имя результирующего файла; по умолчанию,
-          совпадает с именем главного модуля, но с другим расширением
-          (соответствует типу исполняемого файла)
-      -stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб,
-          допустимо от 1 до 32 Мб)
-      -tab <width> размер табуляции (используется для вычисления координат в
-          исходном коде), по умолчанию - 4
-      -nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже)
-      -lower разрешить ключевые слова и встроенные идентификаторы в
-          нижнем регистре (по умолчанию)
-      -upper только верхний регистр для ключевых слов и встроенных
-          идентификаторов
-      -def <имя> задать символ условной компиляции
-      -ver <major.minor> версия программы (только для kosdll)
-      -uses вывести список импортированных модулей
-
-      параметр -nochk задается в виде строки из символов:
-      "p" - указатели
-      "t" - типы
-      "i" - индексы
-      "b" - неявное приведение INTEGER к BYTE
-      "c" - диапазон аргумента функции CHR
-      "w" - диапазон аргумента функции WCHR
-      "r" - эквивалентно "bcw"
-      "a" - все проверки
-
-      Порядок символов может быть любым. Наличие в строке того или иного
-      символа отключает соответствующую проверку.
-
-      Например: -nochk it - отключить проверку индексов и охрану типа.
-      -nochk a - отключить все отключаемые проверки.
-
-  Например:
-
-  Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -stk 1
-  Compiler.exe "C:\example.ob07" win32dll -out "C:\example.dll"
-  Compiler.exe "C:\example.ob07" win32gui -out "C:\example.exe" -stk 4
-  Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -nochk pti
-  Compiler.kex "/tmp0/1/example.ob07" kosexe -out "/tmp0/1/example.kex" -stk 4
-  Compiler.kex "/tmp0/1/example.ob07" kosdll -out "/tmp0/1/mydll.obj" -ver 2.7
-  Compiler.exe "C:\example.ob07" linux32exe -out "C:\example" -stk 1 -nochk a
-
-  В случае успешной компиляции, компилятор передает код завершения 0, иначе 1.
-При работе компилятора в KolibriOS, код завершения не передается.
-
-------------------------------------------------------------------------------
-        Отличия от оригинала
-
-1.      Расширен псевдомодуль SYSTEM
-2.      В идентификаторах допускается символ "_"
-3.      Добавлены системные флаги
-4.      Усовершенствован оператор CASE (добавлены константные выражения в
-        метках вариантов и необязательная ветка ELSE)
-5.      Расширен набор стандартных процедур
-6.      Семантика охраны/проверки типа уточнена для нулевого указателя
-7.      Добавлены однострочные комментарии (начинаются с пары символов "//")
-8.      Разрешено наследование от типа-указателя
-9.      Добавлен синтаксис для импорта процедур из внешних библиотек
-10.     "Строки" можно заключать также в одиночные кавычки: 'строка'
-11.     Добавлен тип WCHAR
-12.     Добавлена операция конкатенации строковых и символьных констант
-13.     Возможен импорт модулей с указанием пути и имени файла
-14.     Добавлен специальный синтаксис для условной компиляции (см. CC.txt)
-15.     Имя процедуры в конце объявления (после END) необязательно
-16.     Разрешено использовать нижний регистр для ключевых слов
-
-------------------------------------------------------------------------------
-        Особенности реализации
-
-1.      Основные типы
-
-          Тип              Диапазон значений               Размер, байт
-
-        INTEGER       -2147483648 .. 2147483647                 4
-        REAL          4.94E-324 .. 1.70E+308                    8
-        CHAR          символ ASCII (0X .. 0FFX)                 1
-        BOOLEAN       FALSE, TRUE                               1
-        SET           множество из целых чисел {0 .. 31}        4
-        BYTE          0 .. 255                                  1
-        WCHAR         символ юникода (0X .. 0FFFFX)             2
-
-2.      Максимальная длина идентификаторов - 255 символов
-3.      Максимальная длина строковых констант - 511 символов (UTF-8)
-4.      Максимальная размерность открытых массивов - 5
-5.      Процедура NEW заполняет нулями выделенный блок памяти
-6.      Глобальные и локальные переменные инициализируются нулями
-7.      В отличие от многих Oberon-реализаций, сборщик мусора и динамическая
-        модульность отсутствуют
-8.      Тип BYTE в выражениях всегда приводится к INTEGER
-9.      Контроль переполнения значений выражений не производится
-10.     Ошибки времени выполнения:
-
- 1      ASSERT(x), при x = FALSE
- 2      разыменование нулевого указателя
- 3      целочисленное деление на неположительное число
- 4      вызов процедуры через процедурную переменную с нулевым значением
- 5      ошибка охраны типа
- 6      нарушение границ массива
- 7      непредусмотренное значение выражения в операторе CASE
- 8      ошибка копирования массивов v := x, если LEN(v) < LEN(x)
- 9      CHR(x), если (x < 0) OR (x > 255)
-10      WCHR(x), если (x < 0) OR (x > 65535)
-11      неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255)
-
-------------------------------------------------------------------------------
-        Псевдомодуль SYSTEM
-
-  Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры,
-ошибки при использовании процедур псевдомодуля SYSTEM могут привести к
-повреждению данных времени выполнения и аварийному завершению программы.
-
-        PROCEDURE ADR(v: любой тип): INTEGER
-                v - переменная или процедура;
-                возвращает адрес v
-
-        PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER
-                возвращает адрес x
-
-        PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER
-                возвращает адрес x
-
-        PROCEDURE VAL(v: любой тип; T): T
-                v - переменная;
-                интерпретирует v, как переменную типа T
-
-        PROCEDURE SIZE(T): INTEGER
-                возвращает размер типа T
-
-        PROCEDURE TYPEID(T): INTEGER
-                T - тип-запись или тип-указатель,
-                возвращает номер типа в таблице типов-записей
-
-        PROCEDURE INF(): REAL
-                возвращает специальное вещественное значение "бесконечность"
-
-        PROCEDURE MOVE(Source, Dest, n: INTEGER)
-                Копирует n байт памяти из Source в Dest,
-                области Source и Dest не могут перекрываться
-
-        PROCEDURE GET(a: INTEGER;
-                VAR v: любой основной тип, PROCEDURE, POINTER)
-                v := Память[a]
-
-        PROCEDURE GET8(a: INTEGER;
-                       VAR x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
-                Эквивалентно
-                SYSTEM.MOVE(a, SYSTEM.ADR(x), 1)
-
-        PROCEDURE GET16(a: INTEGER;
-                        VAR x: INTEGER, SET, WCHAR, SYSTEM.CARD32)
-                Эквивалентно
-                SYSTEM.MOVE(a, SYSTEM.ADR(x), 2)
-
-        PROCEDURE GET32(a: INTEGER; VAR x: INTEGER, SET, SYSTEM.CARD32)
-                Эквивалентно
-                SYSTEM.MOVE(a, SYSTEM.ADR(x), 4)
-
-        PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER)
-                Память[a] := x;
-                Если x: BYTE или x: WCHAR, то значение x будет расширено
-                до 32 бит, для записи байтов использовать SYSTEM.PUT8,
-                для WCHAR -- SYSTEM.PUT16
-
-        PROCEDURE PUT8(a: INTEGER;
-                       x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
-                Память[a] := младшие 8 бит (x)
-
-        PROCEDURE PUT16(a: INTEGER;
-                        x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
-                Память[a] := младшие 16 бит (x)
-
-        PROCEDURE PUT32(a: INTEGER;
-                        x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
-                Память[a] := младшие 32 бит (x)
-
-        PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER)
-                Копирует n байт памяти из Source в Dest.
-                Эквивалентно
-                SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n)
-
-        PROCEDURE CODE(byte1, byte2,... : INTEGER)
-                Вставка машинного кода,
-                byte1, byte2 ... - константы в диапазоне 0..255,
-                например:
-                SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *)
-
-  Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не
-допускаются никакие явные операции, за исключением присваивания.
-
-  Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях.
-
-------------------------------------------------------------------------------
-        Системные флаги
-
-  При объявлении процедурных типов и глобальных процедур, после ключевого
-слова PROCEDURE может быть указан флаг соглашения о вызове: [stdcall],
-[cdecl], [fastcall], [ccall], [windows], [linux], [oberon]. Например:
-
-        PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER;
-
-  Если указан флаг [ccall], то принимается соглашение cdecl, но перед
-вызовом указатель стэка будет выравнен по границе 16 байт.
-  Флаг [windows] - синоним для [stdcall], [linux] - синоним для [ccall].
-  Знак "-" после имени флага ([stdcall-], [linux-], ...) означает, что
-результат процедуры можно игнорировать (не допускается для типа REAL).
-  Если флаг не указан или указан флаг [oberon], то принимается внутреннее
-соглашение о вызове.
-
-  При объявлении типов-записей, после ключевого слова RECORD может быть
-указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей
-записи. Записи с системным флагом не могут иметь базовый тип и не могут быть
-базовыми типами для других записей.
-  Для использования системных флагов, требуется импортировать SYSTEM.
-
-------------------------------------------------------------------------------
-        Оператор CASE
-
-  Синтаксис оператора CASE:
-
-        CaseStatement =
-                CASE Expression OF Case {"|" Case}
-                        [ELSE StatementSequence] END.
-        Case = [CaseLabelList ":" StatementSequence].
-        CaseLabelList = CaseLabels {"," CaseLabels}.
-        CaseLabels = ConstExpression [".." ConstExpression].
-
-  Например:
-
-        CASE x OF
-        |-1:    DoSomething1
-        | 1:    DoSomething2
-        | 0:    DoSomething3
-        ELSE
-                DoSomething4
-        END
-
-  В метках вариантов можно использовать константные выражения, ветка ELSE
-необязательна. Если значение x не соответствует ни одному варианту и ELSE
-отсутствует, то программа прерывается с ошибкой времени выполнения.
-
-------------------------------------------------------------------------------
-        Тип WCHAR
-
-  Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и
-ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и
-ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает
-только тип CHAR. Для получения значения типа WCHAR, следует использовать
-процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять
-исходный код в кодировке UTF-8 с BOM.
-
-------------------------------------------------------------------------------
-        Конкатенация строковых и символьных констант
-
-  Допускается конкатенация ("+") константных строк и символов типа CHAR:
-
-  str = CHR(39) + "string" + CHR(39); (* str = "'string'" *)
-
-  newline = 0DX + 0AX;
-
-------------------------------------------------------------------------------
-        Проверка и охрана типа нулевого указателя
-
-  Оригинальное сообщение о языке не определяет поведение программы при
-выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих
-Oberon-реализациях выполнение такой операции приводит к ошибке времени
-выполнения. В данной реализации охрана типа нулевого указателя не приводит к
-ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет
-значительно сократить частоту применения охраны типа.
-
-------------------------------------------------------------------------------
-        Дополнительные стандартные процедуры
-
-        DISPOSE (VAR v: любой_указатель)
-                Освобождает память, выделенную процедурой NEW для
-                динамической переменной v^, и присваивает переменной v
-                значение NIL.
-
-        COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR);
-                v := x;
-                Если LEN(v) < LEN(x), то строка x будет скопирована
-                не полностью
-
-        LSR (x, n: INTEGER): INTEGER
-                Логический сдвиг x на n бит вправо.
-
-        MIN (a, b: INTEGER): INTEGER
-                Минимум из двух значений.
-
-        MAX (a, b: INTEGER): INTEGER
-                Максимум из двух значений.
-
-        BITS (x: INTEGER): SET
-                Интерпретирует x как значение типа SET.
-                Выполняется на этапе компиляции.
-
-        LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER
-                Длина 0X-завершенной строки s, без учета символа 0X.
-                Если символ 0X отсутствует, функция возвращает длину
-                массива s. s не может быть константой.
-
-        WCHR (n: INTEGER): WCHAR
-                Преобразование типа, аналогично CHR(n: INTEGER): CHAR
-
-------------------------------------------------------------------------------
-        Импорт модулей с указанием пути и имени файла
-
-Примеры:
-
-    IMPORT Math IN "./lib/math.ob07"; (* относительно текущего модуля *)
-
-    IMPORT M1 IN "C:\lib\math.ob07"; (* абсолютный путь *)
-
-------------------------------------------------------------------------------
-        Импортированные процедуры
-
-  Синтаксис импорта:
-
-  PROCEDURE [callconv, library, function] proc_name (FormalParam): Type;
-
-  - callconv -- соглашение о вызове
-  - library -- имя файла динамической библиотеки (строковая константа)
-  - function -- имя импортируемой процедуры (строковая константа), если
-  указана пустая строка, то имя процедуры = proc_name
-
-  например:
-
-  PROCEDURE [windows, "kernel32.dll", ""] ExitProcess (code: INTEGER);
-
-  PROCEDURE [stdcall, "Console.obj", "con_exit"] exit (bCloseWindow: BOOLEAN);
-
-  В конце объявления может быть добавлено (необязательно) "END proc_name;"
-
-  Объявления импортированных процедур должны располагаться в глобальной
-  области видимости модуля после объявления переменных, вместе с объявлением
-  "обычных" процедур, от которых импортированные отличаются только отсутствием
-  тела процедуры. В остальном, к таким процедурам применимы те же правила:
-  их можно вызвать, присвоить процедурной переменной или получить адрес.
-
-  Так как импортированная процедура всегда имеет явное указание соглашения о
-  вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием
-  соглашения о вызове:
-
-  VAR
-      ExitProcess: PROCEDURE [windows] (code: INTEGER);
-      con_exit:    PROCEDURE [stdcall] (bCloseWindow: BOOLEAN);
-
-  В KolibriOS импортировать процедуры можно только из библиотек, размещенных
-  в /sys/lib. Импортировать и вызывать функции инициализации библиотек
-  (lib_init, START) при этом не нужно.
-
-  Для Linux, импортированные процедуры не реализованы.
-
-------------------------------------------------------------------------------
-        Скрытые параметры процедур
-
-  Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке
-формальных параметров, но учитываются компилятором при трансляции вызовов.
-Это возможно в следующих случаях:
-
-1.      Процедура имеет формальный параметр открытый массив:
-                PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL);
-        Вызов транслируется так:
-                Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x))
-2.      Процедура имеет формальный параметр-переменную типа RECORD:
-                PROCEDURE Proc (VAR x: Rec);
-        Вызов транслируется так:
-                Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x))
-
-  Скрытые параметры необходимо учитывать при связи с внешними приложениями.
-
-------------------------------------------------------------------------------
-        Модуль RTL
-
-  Все программы неявно используют модуль RTL. Компилятор транслирует
-некоторые операции (проверка и охрана типа, сравнение строк, сообщения об
-ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не
-следует вызывать эти процедуры явно.
-  Сообщения об ошибках времени выполнения выводятся в диалоговых окнах
-(Windows), в терминал (Linux), на доску отладки (KolibriOS).
-
-------------------------------------------------------------------------------
-        Модуль API
-
-  Существуют несколько реализаций модуля API (для различных ОС).
-  Как и модуль RTL, модуль API не предназначен для прямого использования.
-Он обеспечивает связь RTL с ОС.
-
-------------------------------------------------------------------------------
-        Генерация исполняемых файлов DLL
-
-  Разрешается экспортировать только процедуры. Для этого, процедура должна
-находиться в главном модуле программы, и ее имя должно быть отмечено символом
-экспорта ("*"). Нельзя экспортировать процедуры, которые импортированы из
-других dll-библиотек.
-
-  KolibriOS DLL всегда экспортируют идентификаторы "version" (версия
-программы) и "lib_init" - адрес процедуры инициализации DLL:
-
-        PROCEDURE [stdcall] lib_init (): INTEGER
-
-Эта процедура должна быть вызвана перед использованием DLL.
-Процедура всегда возвращает 1.

programs/develop/oberon07/lib/KolibriOS/API.ob07

@@ -1,290 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018, 2020-2022, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE API;
-
-IMPORT SYSTEM, K := KOSAPI;
-
-
-CONST
-
-    eol* = 0DX + 0AX;
-    BIT_DEPTH* = 32;
-
-    MAX_SIZE  = 16 * 400H;
-    HEAP_SIZE =  1 * 100000H;
-
-    _new = 1;
-    _dispose = 2;
-
-    SizeOfHeader = 36;
-
-
-TYPE
-
-    CRITICAL_SECTION = ARRAY 2 OF INTEGER;
-
-
-VAR
-
-    heap, endheap: INTEGER;
-    pockets: ARRAY MAX_SIZE DIV 32 + 1 OF INTEGER;
-
-    CriticalSection: CRITICAL_SECTION;
-
-    multi: BOOLEAN;
-
-    base*: INTEGER;
-
-
-PROCEDURE [stdcall] zeromem* (dwords: INTEGER; adr: INTEGER);
-BEGIN
-    SYSTEM.CODE(
-    0FCH,               (*  cld                            *)
-    031H, 0C0H,         (*  xor     eax, eax               *)
-    057H,               (*  push    edi                    *)
-    08BH, 07DH, 00CH,   (*  mov     edi, dword [ebp + 12]  *)
-    08BH, 04DH, 008H,   (*  mov     ecx, dword [ebp +  8]  *)
-    0F3H, 0ABH,         (*  rep     stosd                  *)
-    05FH                (*  pop     edi                    *)
-    )
-END zeromem;
-
-
-PROCEDURE mem_commit* (adr, size: INTEGER);
-VAR
-    tmp: INTEGER;
-BEGIN
-    FOR tmp := adr TO adr + size - 1 BY 4096 DO
-        SYSTEM.PUT(tmp, 0)
-    END
-END mem_commit;
-
-
-PROCEDURE switch_task;
-BEGIN
-    K.sysfunc2(68, 1)
-END switch_task;
-
-
-PROCEDURE futex_create (ptr: INTEGER): INTEGER;
-    RETURN K.sysfunc3(77, 0, ptr)
-END futex_create;
-
-
-PROCEDURE futex_wait (futex, value, timeout: INTEGER);
-BEGIN
-    K.sysfunc5(77, 2, futex, value, timeout)
-END futex_wait;
-
-
-PROCEDURE futex_wake (futex, number: INTEGER);
-BEGIN
-    K.sysfunc4(77, 3, futex, number)
-END futex_wake;
-
-
-PROCEDURE EnterCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
-BEGIN
-    switch_task;
-    futex_wait(CriticalSection[0], 1, 10000);
-    CriticalSection[1] := 1
-END EnterCriticalSection;
-
-
-PROCEDURE LeaveCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
-BEGIN
-    CriticalSection[1] := 0;
-    futex_wake(CriticalSection[0], 1)
-END LeaveCriticalSection;
-
-
-PROCEDURE InitializeCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
-BEGIN
-    CriticalSection[0] := futex_create(SYSTEM.ADR(CriticalSection[1]));
-    CriticalSection[1] := 0
-END InitializeCriticalSection;
-
-
-PROCEDURE __NEW (size: INTEGER): INTEGER;
-VAR
-    res, idx, temp: INTEGER;
-BEGIN
-    IF size <= MAX_SIZE THEN
-        idx := ASR(size, 5);
-        res := pockets[idx];
-        IF res # 0 THEN
-            SYSTEM.GET(res, pockets[idx]);
-            SYSTEM.PUT(res, size);
-            INC(res, 4)
-        ELSE
-            temp := 0;
-            IF heap + size >= endheap THEN
-                IF K.sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN
-                    temp := K.sysfunc3(68, 12, HEAP_SIZE)
-                ELSE
-                    temp := 0
-                END;
-                IF temp # 0 THEN
-                    mem_commit(temp, HEAP_SIZE);
-                    heap := temp;
-                    endheap := heap + HEAP_SIZE
-                ELSE
-                    temp := -1
-                END
-            END;
-            IF (heap # 0) & (temp # -1) THEN
-                SYSTEM.PUT(heap, size);
-                res := heap + 4;
-                heap := heap + size
-            ELSE
-                res := 0
-            END
-        END
-    ELSE
-        IF K.sysfunc2(18, 16) > ASR(size, 10) THEN
-            res := K.sysfunc3(68, 12, size);
-            IF res # 0 THEN
-                mem_commit(res, size);
-                SYSTEM.PUT(res, size);
-                INC(res, 4)
-            END
-        ELSE
-            res := 0
-        END
-    END;
-    IF (res # 0) & (size <= MAX_SIZE) THEN
-        zeromem(ASR(size, 2) - 1, res)
-    END
-    RETURN res
-END __NEW;
-
-
-PROCEDURE __DISPOSE (ptr: INTEGER): INTEGER;
-VAR
-    size, idx: INTEGER;
-BEGIN
-    DEC(ptr, 4);
-    SYSTEM.GET(ptr, size);
-    IF size <= MAX_SIZE THEN
-        idx := ASR(size, 5);
-        SYSTEM.PUT(ptr, pockets[idx]);
-        pockets[idx] := ptr
-    ELSE
-        size := K.sysfunc3(68, 13, ptr)
-    END
-    RETURN 0
-END __DISPOSE;
-
-
-PROCEDURE NEW_DISPOSE (func, arg: INTEGER): INTEGER;
-VAR
-    res: INTEGER;
-
-BEGIN
-    IF multi THEN
-        EnterCriticalSection(CriticalSection)
-    END;
-
-    IF func = _new THEN
-        res := __NEW(arg)
-    ELSIF func = _dispose THEN
-        res := __DISPOSE(arg)
-    END;
-
-    IF multi THEN
-        LeaveCriticalSection(CriticalSection)
-    END
-
-    RETURN res
-END NEW_DISPOSE;
-
-
-PROCEDURE _NEW* (size: INTEGER): INTEGER;
-    RETURN NEW_DISPOSE(_new, size)
-END _NEW;
-
-
-PROCEDURE _DISPOSE* (ptr: INTEGER): INTEGER;
-    RETURN NEW_DISPOSE(_dispose, ptr)
-END _DISPOSE;
-
-
-PROCEDURE exit* (p1: INTEGER);
-BEGIN
-    K.sysfunc1(-1)
-END exit;
-
-
-PROCEDURE exit_thread* (p1: INTEGER);
-BEGIN
-    K.sysfunc1(-1)
-END exit_thread;
-
-
-PROCEDURE OutStr (pchar: INTEGER);
-VAR
-    c: CHAR;
-BEGIN
-    IF pchar # 0 THEN
-        REPEAT
-            SYSTEM.GET(pchar, c);
-            IF c # 0X THEN
-                K.OutChar(c)
-            END;
-            INC(pchar)
-        UNTIL c = 0X
-    END
-END OutStr;
-
-
-PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
-BEGIN
-    IF lpCaption # 0 THEN
-        K.OutLn;
-        OutStr(lpCaption);
-        K.OutChar(":");
-        K.OutLn
-    END;
-    OutStr(lpText);
-    IF lpCaption # 0 THEN
-        K.OutLn
-    END
-END DebugMsg;
-
-
-PROCEDURE init* (import_, code: INTEGER);
-BEGIN
-    multi := FALSE;
-    base := code - SizeOfHeader;
-    K.sysfunc2(68, 11);
-    InitializeCriticalSection(CriticalSection);
-    K._init(import_)
-END init;
-
-
-PROCEDURE SetMultiThr* (value: BOOLEAN);
-BEGIN
-    multi := value
-END SetMultiThr;
-
-
-PROCEDURE GetTickCount* (): INTEGER;
-    RETURN K.sysfunc2(26, 9) * 10
-END GetTickCount;
-
-
-PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
-    RETURN 0
-END dllentry;
-
-
-PROCEDURE sofinit*;
-END sofinit;
-
-
-END API.

programs/develop/oberon07/lib/KolibriOS/Args.ob07

@@ -1,100 +0,0 @@
-(*
-    Copyright 2016, 2018 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE Args;
-
-IMPORT sys := SYSTEM, KOSAPI;
-
-CONST
-
-  MAX_PARAM = 1024;
-
-VAR
-
-  Params: ARRAY MAX_PARAM, 2 OF INTEGER;
-  argc*: INTEGER;
-
-PROCEDURE GetChar(adr: INTEGER): CHAR;
-VAR res: CHAR;
-BEGIN
-  sys.GET(adr, res)
-  RETURN res
-END GetChar;
-
-PROCEDURE ParamParse;
-VAR p, count, name: INTEGER; c: CHAR; cond: INTEGER;
-
-  PROCEDURE ChangeCond(A, B, C: INTEGER; c: CHAR; VAR cond: INTEGER);
-  BEGIN
-    IF (c <= 20X) & (c # 0X) THEN
-      cond := A
-    ELSIF c = 22X THEN
-      cond := B
-    ELSIF c = 0X THEN
-      cond := 6
-    ELSE
-      cond := C
-    END
-  END ChangeCond;
-
-BEGIN
-  p := KOSAPI.GetCommandLine();
-  name := KOSAPI.GetName();
-  Params[0, 0] := name;
-  WHILE GetChar(name) # 0X DO
-    INC(name)
-  END;
-  Params[0, 1] := name - 1;
-  cond := 0;
-  count := 1;
-  WHILE (argc < MAX_PARAM) & (cond # 6) DO
-    c := GetChar(p);
-    CASE cond OF
-    |0: ChangeCond(0, 4, 1, c, cond); IF cond = 1 THEN Params[count, 0] := p END
-    |1: ChangeCond(0, 3, 1, c, cond); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
-    |3: ChangeCond(3, 1, 3, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
-    |4: ChangeCond(5, 0, 5, c, cond); IF cond = 5 THEN Params[count, 0] := p END
-    |5: ChangeCond(5, 1, 5, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
-    ELSE
-    END;
-    INC(p)
-  END;
-  argc := count
-END ParamParse;
-
-PROCEDURE GetArg*(n: INTEGER; VAR s: ARRAY OF CHAR);
-VAR i, j, len: INTEGER; c: CHAR;
-BEGIN
-  j := 0;
-  IF n < argc THEN
-    len := LEN(s) - 1;
-    i := Params[n, 0];
-    WHILE (j < len) & (i <= Params[n, 1]) DO
-      c := GetChar(i);
-      IF c # 22X THEN
-        s[j] := c;
-        INC(j)
-      END;
-      INC(i);
-    END;
-  END;
-  s[j] := 0X
-END GetArg;
-
-BEGIN
-  ParamParse
-END Args.

programs/develop/oberon07/lib/KolibriOS/ColorDlg.ob07

@@ -1,105 +0,0 @@
-(*
-    Copyright 2016, 2018, 2020, 2022 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE ColorDlg;
-
-IMPORT sys := SYSTEM, KOSAPI;
-
-TYPE
-
-  DRAW_WINDOW = PROCEDURE;
-
-  TDialog = RECORD
-    _type,
-    procinfo,
-    com_area_name,
-    com_area,
-    start_path: INTEGER;
-    draw_window: DRAW_WINDOW;
-    status*,
-    X, Y,
-    color_type,
-    color*: INTEGER;
-
-    procinf: ARRAY 1024 OF CHAR;
-    s_com_area_name: ARRAY 32 OF CHAR
-  END;
-
-  Dialog* = POINTER TO TDialog;
-
-VAR
-
-  Dialog_start, Dialog_init: PROCEDURE [stdcall] (cd: Dialog);
-
-PROCEDURE Show*(cd: Dialog);
-BEGIN
-  IF cd # NIL THEN
-    cd.X := 0;
-    cd.Y := 0;
-    Dialog_start(cd)
-  END
-END Show;
-
-PROCEDURE Create*(draw_window: DRAW_WINDOW): Dialog;
-VAR res: Dialog;
-BEGIN
-  NEW(res);
-  IF res # NIL THEN
-    res.s_com_area_name := "FFFFFFFF_color_dlg";
-    res.com_area := 0;
-    res._type := 0;
-    res.color_type := 0;
-    res.procinfo := sys.ADR(res.procinf[0]);
-    res.com_area_name := sys.ADR(res.s_com_area_name[0]);
-    res.start_path := sys.SADR("/sys/colrdial");
-    res.draw_window := draw_window;
-    res.status := 0;
-    res.X := 0;
-    res.Y := 0;
-    res.color := 0;
-    Dialog_init(res)
-  END
-  RETURN res
-END Create;
-
-PROCEDURE Destroy*(VAR cd: Dialog);
-BEGIN
-  IF cd # NIL THEN
-    DISPOSE(cd)
-  END
-END Destroy;
-
-PROCEDURE Load;
-VAR Lib: INTEGER;
-
-  PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
-  VAR a: INTEGER;
-  BEGIN
-    a := KOSAPI.GetProcAdr(name, Lib);
-    ASSERT(a # 0);
-    sys.PUT(v, a)
-  END GetProc;
-
-BEGIN
-  Lib := KOSAPI.LoadLib("/sys/Lib/Proc_lib.obj");
-  GetProc(Lib, sys.ADR(Dialog_init), "ColorDialog_init");
-  GetProc(Lib, sys.ADR(Dialog_start), "ColorDialog_start");
-END Load;
-
-BEGIN
-  Load
-END ColorDlg.

programs/develop/oberon07/lib/KolibriOS/Console.ob07

@@ -1,94 +0,0 @@
-(*
-    Copyright 2016, 2018 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE Console;
-
-IMPORT ConsoleLib, In, Out;
-
-
-CONST
-
-    Black* = 0;      Blue* = 1;           Green* = 2;        Cyan* = 3;
-    Red* = 4;        Magenta* = 5;        Brown* = 6;        LightGray* = 7;
-    DarkGray* = 8;   LightBlue* = 9;      LightGreen* = 10;  LightCyan* = 11;
-    LightRed* = 12;  LightMagenta* = 13;  Yellow* = 14;      White* = 15;
-
-
-PROCEDURE SetCursor* (X, Y: INTEGER);
-BEGIN
-    ConsoleLib.set_cursor_pos(X, Y)
-END SetCursor;
-
-
-PROCEDURE GetCursor* (VAR X, Y: INTEGER);
-BEGIN
-    ConsoleLib.get_cursor_pos(X, Y)
-END GetCursor;
-
-
-PROCEDURE Cls*;
-BEGIN
-    ConsoleLib.cls
-END Cls;
-
-
-PROCEDURE SetColor* (FColor, BColor: INTEGER);
-VAR
-    res: INTEGER;
-
-BEGIN
-    IF (FColor IN {0..15}) & (BColor IN {0..15}) THEN
-        res := ConsoleLib.set_flags(LSL(BColor, 4) + FColor)
-    END
-END SetColor;
-
-
-PROCEDURE GetCursorX* (): INTEGER;
-VAR
-    x, y: INTEGER;
-
-BEGIN
-    ConsoleLib.get_cursor_pos(x, y)
-    RETURN x
-END GetCursorX;
-
-
-PROCEDURE GetCursorY* (): INTEGER;
-VAR
-    x, y: INTEGER;
-
-BEGIN
-    ConsoleLib.get_cursor_pos(x, y)
-    RETURN y
-END GetCursorY;
-
-
-PROCEDURE open*;
-BEGIN
-    ConsoleLib.open(-1, -1, -1, -1, "");
-    In.Open;
-    Out.Open
-END open;
-
-
-PROCEDURE exit* (bCloseWindow: BOOLEAN);
-BEGIN
-    ConsoleLib.exit(bCloseWindow)
-END exit;
-
-
-END Console.

programs/develop/oberon07/lib/KolibriOS/ConsoleLib.ob07

@@ -1,103 +0,0 @@
-(*
-    Copyright 2016, 2018, 2022 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE ConsoleLib;
-
-IMPORT sys := SYSTEM, KOSAPI;
-
-CONST
-
-    COLOR_BLUE*      = 001H;
-    COLOR_GREEN*     = 002H;
-    COLOR_RED*       = 004H;
-    COLOR_BRIGHT*    = 008H;
-    BGR_BLUE*        = 010H;
-    BGR_GREEN*       = 020H;
-    BGR_RED*         = 040H;
-    BGR_BRIGHT*      = 080H;
-    IGNORE_SPECIALS* = 100H;
-    WINDOW_CLOSED*   = 200H;
-
-TYPE
-
-    gets2_callback* = PROCEDURE [stdcall] (keycode: INTEGER; pstr: INTEGER; VAR n, pos: INTEGER);
-
-VAR
-
-    version*           : INTEGER;
-    init*              : PROCEDURE [stdcall] (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER);
-    exit*              : PROCEDURE [stdcall] (bCloseWindow: BOOLEAN);
-    write_asciiz*      : PROCEDURE [stdcall] (string: INTEGER);
-    write_string*      : PROCEDURE [stdcall] (string, length: INTEGER);
-    get_flags*         : PROCEDURE [stdcall] (): INTEGER;
-    set_flags*         : PROCEDURE [stdcall] (new_flags: INTEGER): INTEGER;
-    get_font_height*   : PROCEDURE [stdcall] (): INTEGER;
-    get_cursor_height* : PROCEDURE [stdcall] (): INTEGER;
-    set_cursor_height* : PROCEDURE [stdcall] (new_height: INTEGER): INTEGER;
-    getch*             : PROCEDURE [stdcall] (): INTEGER;
-    getch2*            : PROCEDURE [stdcall] (): INTEGER;
-    kbhit*             : PROCEDURE [stdcall] (): INTEGER;
-    gets*              : PROCEDURE [stdcall] (str, n: INTEGER): INTEGER;
-    gets2*             : PROCEDURE [stdcall] (callback: gets2_callback; str, n: INTEGER): INTEGER;
-    cls*               : PROCEDURE [stdcall] ();
-    get_cursor_pos*    : PROCEDURE [stdcall] (VAR x, y: INTEGER);
-    set_cursor_pos*    : PROCEDURE [stdcall] (x, y: INTEGER);
-    set_title*         : PROCEDURE [stdcall] (title: INTEGER);
-
-PROCEDURE open*(wnd_width, wnd_height, scr_width, scr_height: INTEGER; title: ARRAY OF CHAR);
-BEGIN
-  init(wnd_width, wnd_height, scr_width, scr_height, sys.ADR(title[0]))
-END open;
-
-PROCEDURE main;
-VAR Lib: INTEGER;
-
-  PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
-  VAR a: INTEGER;
-  BEGIN
-    a := KOSAPI.GetProcAdr(name, Lib);
-    ASSERT(a # 0);
-    sys.PUT(v, a)
-  END GetProc;
-
-BEGIN
-  Lib := KOSAPI.LoadLib("/sys/lib/Console.obj");
-  ASSERT(Lib # 0);
-  GetProc(Lib, sys.ADR(version),           "version");
-  GetProc(Lib, sys.ADR(init),              "con_init");
-  GetProc(Lib, sys.ADR(exit),              "con_exit");
-  GetProc(Lib, sys.ADR(write_asciiz),      "con_write_asciiz");
-  GetProc(Lib, sys.ADR(write_string),      "con_write_string");
-  GetProc(Lib, sys.ADR(get_flags),         "con_get_flags");
-  GetProc(Lib, sys.ADR(set_flags),         "con_set_flags");
-  GetProc(Lib, sys.ADR(get_font_height),   "con_get_font_height");
-  GetProc(Lib, sys.ADR(get_cursor_height), "con_get_cursor_height");
-  GetProc(Lib, sys.ADR(set_cursor_height), "con_set_cursor_height");
-  GetProc(Lib, sys.ADR(getch),             "con_getch");
-  GetProc(Lib, sys.ADR(getch2),            "con_getch2");
-  GetProc(Lib, sys.ADR(kbhit),             "con_kbhit");
-  GetProc(Lib, sys.ADR(gets),              "con_gets");
-  GetProc(Lib, sys.ADR(gets2),             "con_gets2");
-  GetProc(Lib, sys.ADR(cls),               "con_cls");
-  GetProc(Lib, sys.ADR(get_cursor_pos),    "con_get_cursor_pos");
-  GetProc(Lib, sys.ADR(set_cursor_pos),    "con_set_cursor_pos");
-  GetProc(Lib, sys.ADR(set_title),         "con_set_title");
-END main;
-
-BEGIN
-  main
-END ConsoleLib.

programs/develop/oberon07/lib/KolibriOS/DateTime.ob07

@@ -1,141 +0,0 @@
-(*
-    Copyright 2016, 2018 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE DateTime;
-
-IMPORT KOSAPI;
-
-CONST ERR* = -7.0E5;
-
-PROCEDURE Encode*(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL;
-VAR d, i: INTEGER; M: ARRAY 14 OF CHAR; Res: REAL;
-BEGIN
-  Res := ERR;
-  IF (Year >= 1) & (Year <= 9999) & (Month >= 1) & (Month <= 12) &
-    (Day >= 1) & (Day <= 31) & (Hour >= 0) & (Hour <= 23) &
-    (Min >= 0) & (Min <= 59) & (Sec >= 0) & (Sec <= 59) THEN
-    M := "_303232332323";
-    IF (Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0) THEN
-      M[2] := "1"
-    END;
-    IF Day <= ORD(M[Month]) - ORD("0") + 28 THEN
-      DEC(Year);
-      d := Year * 365 + (Year DIV 4) - (Year DIV 100) + (Year DIV 400) + Day - 693594;
-      FOR i := 1 TO Month - 1 DO
-        d := d + ORD(M[i]) - ORD("0") + 28
-      END;
-      Res := FLT(d) + FLT(Hour * 3600000 + Min * 60000 + Sec * 1000) / 86400000.0
-    END
-  END
-  RETURN Res
-END Encode;
-
-PROCEDURE Decode*(Date: REAL; VAR Year, Month, Day, Hour, Min, Sec: INTEGER): BOOLEAN;
-VAR Res, flag: BOOLEAN; d, t, i: INTEGER; M: ARRAY 14 OF CHAR;
-
-  PROCEDURE MonthDay(n: INTEGER; VAR d, Month: INTEGER; M: ARRAY OF CHAR): BOOLEAN;
-  VAR Res: BOOLEAN;
-  BEGIN
-    Res := FALSE;
-    IF d > ORD(M[n]) - ORD("0") + 28 THEN
-      d := d - ORD(M[n]) + ORD("0") - 28;
-      INC(Month);
-      Res := TRUE
-    END
-    RETURN Res
-  END MonthDay;
-
-BEGIN
-  IF (Date >= -693593.0) & (Date < 2958466.0) THEN
-    d := FLOOR(Date);
-    t := FLOOR((Date - FLT(d)) * 86400000.0);
-    d := d + 693593;
-    Year := 1;
-    Month := 1;
-    WHILE d > 0 DO
-      d := d - 365 - ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0));
-      INC(Year)
-    END;
-    IF d < 0 THEN
-      DEC(Year);
-      d := d + 365 + ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0))
-    END;
-    INC(d);
-    M := "_303232332323";
-    IF (Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0) THEN
-      M[2] := "1"
-    END;
-    i := 1;
-    flag := TRUE;
-    WHILE flag & (i <= 12) DO
-      flag := MonthDay(i, d, Month, M);
-      INC(i)
-    END;
-    Day := d;
-    Hour := t DIV 3600000;
-    t := t MOD 3600000;
-    Min := t DIV 60000;
-    t := t MOD 60000;
-    Sec := t DIV 1000;
-    Res := TRUE
-  ELSE
-    Res := FALSE
-  END
-  RETURN Res
-END Decode;
-
-PROCEDURE Now*(VAR Year, Month, Day, Hour, Min, Sec, Msec: INTEGER);
-VAR date, time: INTEGER;
-BEGIN
-  date  := KOSAPI.sysfunc1(29);
-  time  := KOSAPI.sysfunc1(3);
-
-  Year  := date MOD 16;
-  date  := date DIV 16;
-  Year  := (date MOD 16) * 10 + Year;
-  date  := date DIV 16;
-
-  Month := date MOD 16;
-  date  := date DIV 16;
-  Month := (date MOD 16) * 10 + Month;
-  date  := date DIV 16;
-
-  Day := date MOD 16;
-  date  := date DIV 16;
-  Day := (date MOD 16) * 10 + Day;
-  date  := date DIV 16;
-
-  Hour  := time MOD 16;
-  time  := time DIV 16;
-  Hour  := (time MOD 16) * 10 + Hour;
-  time  := time DIV 16;
-
-  Min := time MOD 16;
-  time  := time DIV 16;
-  Min := (time MOD 16) * 10 + Min;
-  time  := time DIV 16;
-
-  Sec := time MOD 16;
-  time  := time DIV 16;
-  Sec := (time MOD 16) * 10 + Sec;
-  time  := time DIV 16;
-
-  Year := Year + 2000;
-  Msec := 0
-END Now;
-
-END DateTime.

programs/develop/oberon07/lib/KolibriOS/Debug.ob07

@@ -1,292 +0,0 @@
-(*
-    Copyright 2016, 2018, 2022 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE Debug;
-
-IMPORT KOSAPI, sys := SYSTEM;
-
-CONST
-
-  d = 1.0 - 5.0E-12;
-
-VAR
-
-  Realp: PROCEDURE (x: REAL; width: INTEGER);
-
-PROCEDURE Char*(c: CHAR);
-VAR res: INTEGER;
-BEGIN
-  res := KOSAPI.sysfunc3(63, 1, ORD(c))
-END Char;
-
-PROCEDURE String*(s: ARRAY OF CHAR);
-VAR n, i: INTEGER;
-BEGIN
-  n := LENGTH(s);
-  FOR i := 0 TO n - 1 DO
-    Char(s[i])
-  END
-END String;
-
-PROCEDURE WriteInt(x, n: INTEGER);
-VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN;
-BEGIN
-  i := 0;
-  IF n < 1 THEN
-    n := 1
-  END;
-  IF x < 0 THEN
-    x := -x;
-    DEC(n);
-    neg := TRUE
-  END;
-  REPEAT
-    a[i] := CHR(x MOD 10 + ORD("0"));
-    x := x DIV 10;
-    INC(i)
-  UNTIL x = 0;
-  WHILE n > i DO
-    Char(" ");
-    DEC(n)
-  END;
-  IF neg THEN
-    Char("-")
-  END;
-  REPEAT
-    DEC(i);
-    Char(a[i])
-  UNTIL i = 0
-END WriteInt;
-
-PROCEDURE IsNan(AValue: REAL): BOOLEAN;
-VAR h, l: SET;
-BEGIN
-  sys.GET(sys.ADR(AValue), l);
-  sys.GET(sys.ADR(AValue) + 4, h)
-  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
-END IsNan;
-
-PROCEDURE IsInf(x: REAL): BOOLEAN;
-  RETURN ABS(x) = sys.INF()
-END IsInf;
-
-PROCEDURE Int*(x, width: INTEGER);
-VAR i: INTEGER;
-BEGIN
-  IF x # 80000000H THEN
-    WriteInt(x, width)
-  ELSE
-    FOR i := 12 TO width DO
-      Char(20X)
-    END;
-    String("-2147483648")
-  END
-END Int;
-
-PROCEDURE OutInf(x: REAL; width: INTEGER);
-VAR s: ARRAY 5 OF CHAR; i: INTEGER;
-BEGIN
-  IF IsNan(x) THEN
-    s := "Nan";
-    INC(width)
-  ELSIF IsInf(x) & (x > 0.0) THEN
-    s := "+Inf"
-  ELSIF IsInf(x) & (x < 0.0) THEN
-    s := "-Inf"
-  END;
-  FOR i := 1 TO width - 4 DO
-    Char(" ")
-  END;
-  String(s)
-END OutInf;
-
-PROCEDURE Ln*;
-BEGIN
-  Char(0DX);
-  Char(0AX)
-END Ln;
-
-PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
-VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
-BEGIN
-  IF IsNan(x) OR IsInf(x) THEN
-    OutInf(x, width)
-  ELSIF p < 0 THEN
-    Realp(x, width)
-  ELSE
-    len := 0;
-    minus := FALSE;
-    IF x < 0.0 THEN
-      minus := TRUE;
-      INC(len);
-      x := ABS(x)
-    END;
-    e := 0;
-    WHILE x >= 10.0 DO
-      x := x / 10.0;
-      INC(e)
-    END;
-    IF e >= 0 THEN
-      len := len + e + p + 1;
-      IF x > 9.0 + d THEN
-        INC(len)
-      END;
-      IF p > 0 THEN
-        INC(len)
-      END
-    ELSE
-      len := len + p + 2
-    END;
-    FOR i := 1 TO width - len DO
-      Char(" ")
-    END;
-    IF minus THEN
-      Char("-")
-    END;
-    y := x;
-    WHILE (y < 1.0) & (y # 0.0) DO
-      y := y * 10.0;
-      DEC(e)
-    END;
-    IF e < 0 THEN
-      IF x - FLT(FLOOR(x)) > d THEN
-        Char("1");
-        x := 0.0
-      ELSE
-        Char("0");
-        x := x * 10.0
-      END
-    ELSE
-      WHILE e >= 0 DO
-        IF x - FLT(FLOOR(x)) > d THEN
-          IF x > 9.0 THEN
-            String("10")
-          ELSE
-            Char(CHR(FLOOR(x) + ORD("0") + 1))
-          END;
-          x := 0.0
-        ELSE
-          Char(CHR(FLOOR(x) + ORD("0")));
-          x := (x - FLT(FLOOR(x))) * 10.0
-        END;
-        DEC(e)
-      END
-    END;
-    IF p > 0 THEN
-      Char(".")
-    END;
-    WHILE p > 0 DO
-      IF x - FLT(FLOOR(x)) > d THEN
-        Char(CHR(FLOOR(x) + ORD("0") + 1));
-        x := 0.0
-      ELSE
-        Char(CHR(FLOOR(x) + ORD("0")));
-        x := (x - FLT(FLOOR(x))) * 10.0
-      END;
-      DEC(p)
-    END
-  END
-END _FixReal;
-
-PROCEDURE Real*(x: REAL; width: INTEGER);
-VAR e, n, i: INTEGER; minus: BOOLEAN;
-BEGIN
-  IF IsNan(x) OR IsInf(x) THEN
-    OutInf(x, width)
-  ELSE
-    e := 0;
-    n := 0;
-    IF width > 23 THEN
-      n := width - 23;
-      width := 23
-    ELSIF width < 9 THEN
-      width := 9
-    END;
-    width := width - 5;
-    IF x < 0.0 THEN
-      x := -x;
-      minus := TRUE
-    ELSE
-      minus := FALSE
-    END;
-    WHILE x >= 10.0 DO
-      x := x / 10.0;
-      INC(e)
-    END;
-    WHILE (x < 1.0) & (x # 0.0) DO
-      x := x * 10.0;
-      DEC(e)
-    END;
-    IF x > 9.0 + d THEN
-      x := 1.0;
-      INC(e)
-    END;
-    FOR i := 1 TO n DO
-      Char(" ")
-    END;
-    IF minus THEN
-      x := -x
-    END;
-    Realp := Real;
-    _FixReal(x, width, width - 3);
-    Char("E");
-    IF e >= 0 THEN
-      Char("+")
-    ELSE
-      Char("-");
-      e := ABS(e)
-    END;
-    IF e < 100 THEN
-      Char("0")
-    END;
-    IF e < 10 THEN
-      Char("0")
-    END;
-    Int(e, 0)
-  END
-END Real;
-
-PROCEDURE FixReal*(x: REAL; width, p: INTEGER);
-BEGIN
-  Realp := Real;
-  _FixReal(x, width, p)
-END FixReal;
-
-PROCEDURE Open*;
-TYPE
-
-  info_struct = RECORD
-    subfunc: INTEGER;
-    flags:   INTEGER;
-    param:   INTEGER;
-    rsrvd1:  INTEGER;
-    rsrvd2:  INTEGER;
-    fname:   ARRAY 1024 OF CHAR
-  END;
-
-VAR info: info_struct; res: INTEGER;
-BEGIN
-  info.subfunc := 7;
-  info.flags := 0;
-  info.param := sys.SADR(" ");
-  info.rsrvd1 := 0;
-  info.rsrvd2 := 0;
-  info.fname := "/sys/develop/board";
-  res := KOSAPI.sysfunc2(70, sys.ADR(info))
-END Open;
-
-END Debug.

programs/develop/oberon07/lib/KolibriOS/File.ob07

@@ -1,330 +0,0 @@
-(*
-    Copyright 2016, 2018, 2021 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE File;
-
-IMPORT sys := SYSTEM, KOSAPI;
-
-
-CONST
-
-    SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2;
-
-
-TYPE
-
-    FNAME* = ARRAY 520 OF CHAR;
-
-    FS* = POINTER TO rFS;
-
-    rFS* = RECORD
-        subfunc*, pos*, hpos*, bytes*, buffer*: INTEGER;
-        name*: FNAME
-    END;
-
-    FD* = POINTER TO rFD;
-
-    rFD* = RECORD
-        attr*: INTEGER;
-        ntyp*: CHAR;
-        reserved: ARRAY 3 OF CHAR;
-        time_create*, date_create*,
-        time_access*, date_access*,
-        time_modif*,  date_modif*,
-        size*, hsize*: INTEGER;
-        name*: FNAME
-    END;
-
-
-PROCEDURE [stdcall] f_68_27 (file_name: INTEGER; VAR size: INTEGER): INTEGER;
-BEGIN
-    sys.CODE(
-    053H,               (*  push    ebx                    *)
-    06AH, 044H,         (*  push    68                     *)
-    058H,               (*  pop     eax                    *)
-    06AH, 01BH,         (*  push    27                     *)
-    05BH,               (*  pop     ebx                    *)
-    08BH, 04DH, 008H,   (*  mov     ecx, dword [ebp +  8]  *)
-    0CDH, 040H,         (*  int     64                     *)
-    08BH, 04DH, 00CH,   (*  mov     ecx, dword [ebp + 12]  *)
-    089H, 011H,         (*  mov     dword [ecx], edx       *)
-    05BH,               (*  pop     ebx                    *)
-    0C9H,               (*  leave                          *)
-    0C2H, 008H, 000H    (*  ret     8                      *)
-    )
-    RETURN 0
-END f_68_27;
-
-
-PROCEDURE Load* (FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
-    RETURN f_68_27(sys.ADR(FName[0]), size)
-END Load;
-
-
-PROCEDURE GetFileInfo* (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN;
-VAR
-    res2: INTEGER; fs: rFS;
-
-BEGIN
-    fs.subfunc := 5;
-    fs.pos     := 0;
-    fs.hpos    := 0;
-    fs.bytes   := 0;
-    fs.buffer  := sys.ADR(Info);
-    COPY(FName, fs.name)
-
-    RETURN KOSAPI.sysfunc22(70, sys.ADR(fs), res2) = 0
-END GetFileInfo;
-
-
-PROCEDURE FileSize* (FName: ARRAY OF CHAR): INTEGER;
-VAR
-    Info: rFD;
-    res: INTEGER;
-BEGIN
-    IF GetFileInfo(FName, Info) THEN
-        res := Info.size
-    ELSE
-        res := -1
-    END
-    RETURN res
-END FileSize;
-
-
-PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN;
-VAR
-    fd: rFD;
-BEGIN
-    RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
-END Exists;
-
-
-PROCEDURE Close* (VAR F: FS);
-BEGIN
-    IF F # NIL THEN
-        DISPOSE(F)
-    END
-END Close;
-
-
-PROCEDURE Open* (FName: ARRAY OF CHAR): FS;
-VAR
-    F: FS;
-
-BEGIN
-
-    IF Exists(FName) THEN
-        NEW(F);
-        IF F # NIL THEN
-            F.subfunc := 0;
-            F.pos     := 0;
-            F.hpos    := 0;
-            F.bytes   := 0;
-            F.buffer  := 0;
-            COPY(FName, F.name)
-        END
-    ELSE
-        F := NIL
-    END
-
-    RETURN F
-END Open;
-
-
-PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
-VAR
-    F: FS;
-    res, res2: INTEGER;
-
-BEGIN
-
-    IF Exists(FName) THEN
-        NEW(F);
-        IF F # NIL THEN
-            F.subfunc := 8;
-            F.pos     := 0;
-            F.hpos    := 0;
-            F.bytes   := 0;
-            F.buffer  := 0;
-            COPY(FName, F.name);
-            res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
-            DISPOSE(F)
-        ELSE
-            res := -1
-        END
-    ELSE
-        res := -1
-    END
-
-    RETURN res = 0
-END Delete;
-
-
-PROCEDURE Seek* (F: FS; Offset, Origin: INTEGER): INTEGER;
-VAR
-    res: INTEGER;
-    fd: rFD;
-
-BEGIN
-
-    IF (F # NIL) & GetFileInfo(F.name, fd) & (BITS(fd.attr) * {4} = {}) THEN
-        CASE Origin OF
-        |SEEK_BEG: F.pos := Offset
-        |SEEK_CUR: F.pos := F.pos + Offset
-        |SEEK_END: F.pos := fd.size + Offset
-        ELSE
-        END;
-        res := F.pos
-    ELSE
-        res := -1
-    END
-
-    RETURN res
-END Seek;
-
-
-PROCEDURE Read* (F: FS; Buffer, Count: INTEGER): INTEGER;
-VAR
-    res, res2: INTEGER;
-
-BEGIN
-
-    IF F # NIL THEN
-        F.subfunc := 0;
-        F.bytes   := Count;
-        F.buffer  := Buffer;
-        res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
-        IF res2 > 0 THEN
-            F.pos := F.pos + res2
-        END
-    ELSE
-        res2 := 0
-    END
-
-    RETURN res2
-END Read;
-
-
-PROCEDURE Write* (F: FS; Buffer, Count: INTEGER): INTEGER;
-VAR
-    res, res2: INTEGER;
-
-BEGIN
-
-    IF F # NIL THEN
-        F.subfunc := 3;
-        F.bytes   := Count;
-        F.buffer  := Buffer;
-        res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
-        IF res2 > 0 THEN
-            F.pos := F.pos + res2
-        END
-    ELSE
-        res2 := 0
-    END
-
-    RETURN res2
-END Write;
-
-
-PROCEDURE Create* (FName: ARRAY OF CHAR): FS;
-VAR
-    F: FS;
-    res2: INTEGER;
-
-BEGIN
-    NEW(F);
-
-    IF F # NIL THEN
-        F.subfunc := 2;
-        F.pos     := 0;
-        F.hpos    := 0;
-        F.bytes   := 0;
-        F.buffer  := 0;
-        COPY(FName, F.name);
-        IF KOSAPI.sysfunc22(70, sys.ADR(F^), res2) # 0 THEN
-            DISPOSE(F)
-        END
-    END
-
-    RETURN F
-END Create;
-
-
-PROCEDURE DirExists* (FName: ARRAY OF CHAR): BOOLEAN;
-VAR
-    fd: rFD;
-BEGIN
-    RETURN GetFileInfo(FName, fd) & (4 IN BITS(fd.attr))
-END DirExists;
-
-
-PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN;
-VAR
-    F: FS;
-    res, res2: INTEGER;
-
-BEGIN
-    NEW(F);
-
-    IF F # NIL THEN
-        F.subfunc := 9;
-        F.pos     := 0;
-        F.hpos    := 0;
-        F.bytes   := 0;
-        F.buffer  := 0;
-        COPY(DirName, F.name);
-        res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
-        DISPOSE(F)
-    ELSE
-        res := -1
-    END
-
-    RETURN res = 0
-END CreateDir;
-
-
-PROCEDURE DeleteDir* (DirName: ARRAY OF CHAR): BOOLEAN;
-VAR
-    F: FS;
-    res, res2: INTEGER;
-
-BEGIN
-
-    IF DirExists(DirName) THEN
-        NEW(F);
-        IF F # NIL THEN
-            F.subfunc := 8;
-            F.pos := 0;
-            F.hpos := 0;
-            F.bytes := 0;
-            F.buffer := 0;
-            COPY(DirName, F.name);
-            res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
-            DISPOSE(F)
-        ELSE
-            res := -1
-        END
-    ELSE
-        res := -1
-    END
-
-    RETURN res = 0
-END DeleteDir;
-
-
-END File.

programs/develop/oberon07/lib/KolibriOS/HOST.ob07

@@ -1,553 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2022, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE HOST;
-
-IMPORT SYSTEM, K := KOSAPI, API;
-
-
-CONST
-
-    slash* = "/";
-    eol* = 0DX + 0AX;
-
-    bit_depth* = API.BIT_DEPTH;
-    maxint* = ROR(-2, 1);
-    minint* = ROR(1, 1);
-
-    MAX_PARAM = 1024;
-
-
-TYPE
-
-    DAYS = ARRAY 12, 31, 2 OF INTEGER;
-
-    FNAME = ARRAY 520 OF CHAR;
-
-    FS = POINTER TO rFS;
-
-    rFS = RECORD
-        subfunc, pos, hpos, bytes, buffer: INTEGER;
-        name: FNAME
-    END;
-
-    FD = POINTER TO rFD;
-
-    rFD = RECORD
-        attr: INTEGER;
-        ntyp: CHAR;
-        reserved: ARRAY 3 OF CHAR;
-        time_create, date_create,
-        time_access, date_access,
-        time_modif,  date_modif,
-        size, hsize: INTEGER;
-        name: FNAME
-    END;
-
-
-VAR
-
-
-    Console: BOOLEAN;
-
-    days: DAYS;
-
-    Params: ARRAY MAX_PARAM, 2 OF INTEGER;
-    argc*: INTEGER;
-
-    maxreal*, inf*: REAL;
-
-
-PROCEDURE [stdcall, "Console.obj", "con_init"] con_init (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER);
-
-PROCEDURE [stdcall, "Console.obj", "con_exit"] con_exit (bCloseWindow: BOOLEAN);
-
-PROCEDURE [stdcall, "Console.obj", "con_write_string"] con_write_string (string, length: INTEGER);
-
-
-PROCEDURE ExitProcess* (p1: INTEGER);
-BEGIN
-    IF Console THEN
-        con_exit(FALSE)
-    END;
-    K.sysfunc1(-1)
-END ExitProcess;
-
-
-PROCEDURE OutChar* (c: CHAR);
-BEGIN
-    IF Console THEN
-        con_write_string(SYSTEM.ADR(c), 1)
-    ELSE
-        K.sysfunc3(63, 1, ORD(c))
-    END
-END OutChar;
-
-
-PROCEDURE GetFileInfo (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN;
-VAR
-    res2: INTEGER;
-    fs:   rFS;
-
-BEGIN
-    fs.subfunc := 5;
-    fs.pos := 0;
-    fs.hpos := 0;
-    fs.bytes := 0;
-    fs.buffer := SYSTEM.ADR(Info);
-    COPY(FName, fs.name)
-    RETURN K.sysfunc22(70, SYSTEM.ADR(fs), res2) = 0
-END GetFileInfo;
-
-
-PROCEDURE Exists (FName: ARRAY OF CHAR): BOOLEAN;
-VAR
-    fd: rFD;
-
-BEGIN
-    RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
-END Exists;
-
-
-PROCEDURE Close (VAR F: FS);
-BEGIN
-    IF F # NIL THEN
-        DISPOSE(F)
-    END
-END Close;
-
-
-PROCEDURE Open (FName: ARRAY OF CHAR): FS;
-VAR
-    F: FS;
-
-BEGIN
-    IF Exists(FName) THEN
-        NEW(F);
-        IF F # NIL THEN
-            F.subfunc := 0;
-            F.pos := 0;
-            F.hpos := 0;
-            F.bytes := 0;
-            F.buffer := 0;
-            COPY(FName, F.name)
-        END
-    ELSE
-        F := NIL
-    END
-
-    RETURN F
-END Open;
-
-
-PROCEDURE Read (F: FS; Buffer, Count: INTEGER): INTEGER;
-VAR
-    res, res2: INTEGER;
-
-BEGIN
-    IF F # NIL THEN
-        F.subfunc := 0;
-        F.bytes := Count;
-        F.buffer := Buffer;
-        res := K.sysfunc22(70, SYSTEM.ADR(F^), res2);
-        IF res2 > 0 THEN
-            F.pos := F.pos + res2
-        END
-    ELSE
-        res2 := 0
-    END
-
-    RETURN res2
-END Read;
-
-
-PROCEDURE Write (F: FS; Buffer, Count: INTEGER): INTEGER;
-VAR
-    res, res2: INTEGER;
-
-BEGIN
-    IF F # NIL THEN
-        F.subfunc := 3;
-        F.bytes := Count;
-        F.buffer := Buffer;
-        res := K.sysfunc22(70, SYSTEM.ADR(F^), res2);
-        IF res2 > 0 THEN
-            F.pos := F.pos + res2
-        END
-    ELSE
-        res2 := 0
-    END
-
-    RETURN res2
-END Write;
-
-
-PROCEDURE Create (FName: ARRAY OF CHAR): FS;
-VAR
-    F:    FS;
-    res2: INTEGER;
-
-BEGIN
-    NEW(F);
-    IF F # NIL THEN
-        F.subfunc := 2;
-        F.pos := 0;
-        F.hpos := 0;
-        F.bytes := 0;
-        F.buffer := 0;
-        COPY(FName, F.name);
-        IF K.sysfunc22(70, SYSTEM.ADR(F^), res2) # 0 THEN
-            DISPOSE(F)
-        END
-    END
-
-    RETURN F
-END Create;
-
-
-PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
-VAR
-    n: INTEGER;
-    fs: FS;
-
-BEGIN
-    SYSTEM.GET(SYSTEM.ADR(F), fs);
-    n := Read(fs, SYSTEM.ADR(Buffer[0]), bytes);
-    IF n = 0 THEN
-        n := -1
-    END
-
-    RETURN n
-END FileRead;
-
-
-PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
-VAR
-    n: INTEGER;
-    fs: FS;
-
-BEGIN
-    SYSTEM.GET(SYSTEM.ADR(F), fs);
-    n := Write(fs, SYSTEM.ADR(Buffer[0]), bytes);
-    IF n = 0 THEN
-        n := -1
-    END
-
-    RETURN n
-END FileWrite;
-
-
-PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
-VAR
-    fs: FS;
-    res: INTEGER;
-
-BEGIN
-    fs := Create(FName);
-    SYSTEM.GET(SYSTEM.ADR(fs), res)
-    RETURN res
-END FileCreate;
-
-
-PROCEDURE FileClose* (F: INTEGER);
-VAR
-    fs: FS;
-
-BEGIN
-    SYSTEM.GET(SYSTEM.ADR(F), fs);
-    Close(fs)
-END FileClose;
-
-
-PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
-VAR
-    fs: FS;
-    res: INTEGER;
-
-BEGIN
-    fs := Open(FName);
-    SYSTEM.GET(SYSTEM.ADR(fs), res)
-    RETURN res
-END FileOpen;
-
-
-PROCEDURE chmod* (FName: ARRAY OF CHAR);
-END chmod;
-
-
-PROCEDURE GetTickCount* (): INTEGER;
-    RETURN K.sysfunc2(26, 9)
-END GetTickCount;
-
-
-PROCEDURE AppAdr (): INTEGER;
-VAR
-    buf: ARRAY 1024 OF CHAR;
-    a: INTEGER;
-
-BEGIN
-    a := K.sysfunc3(9, SYSTEM.ADR(buf), -1);
-    SYSTEM.GET(SYSTEM.ADR(buf) + 22, a)
-    RETURN a
-END AppAdr;
-
-
-PROCEDURE GetCommandLine (): INTEGER;
-VAR
-    param: INTEGER;
-
-BEGIN
-    SYSTEM.GET(28 + AppAdr(), param)
-    RETURN param
-END GetCommandLine;
-
-
-PROCEDURE GetName (): INTEGER;
-VAR
-    name: INTEGER;
-
-BEGIN
-    SYSTEM.GET(32 + AppAdr(), name)
-    RETURN name
-END GetName;
-
-
-PROCEDURE GetChar (adr: INTEGER): CHAR;
-VAR
-    res: CHAR;
-
-BEGIN
-    SYSTEM.GET(adr, res)
-    RETURN res
-END GetChar;
-
-
-PROCEDURE ParamParse;
-VAR
-    p, count, name, cond: INTEGER;
-    c: CHAR;
-
-
-    PROCEDURE ChangeCond (A, B, C: INTEGER; c: CHAR; VAR cond: INTEGER);
-    BEGIN
-        IF (c <= 20X) & (c # 0X) THEN
-            cond := A
-        ELSIF c = 22X THEN
-            cond := B
-        ELSIF c = 0X THEN
-            cond := 6
-        ELSE
-            cond := C
-        END
-    END ChangeCond;
-
-
-BEGIN
-    p := GetCommandLine();
-    name := GetName();
-    Params[0, 0] := name;
-    WHILE GetChar(name) # 0X DO
-        INC(name)
-    END;
-    Params[0, 1] := name - 1;
-    cond := 0;
-    count := 1;
-    WHILE (argc < MAX_PARAM) & (cond # 6) DO
-        c := GetChar(p);
-        CASE cond OF
-        |0: ChangeCond(0, 4, 1, c, cond); IF cond = 1 THEN Params[count, 0] := p END
-        |1: ChangeCond(0, 3, 1, c, cond); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
-        |3: ChangeCond(3, 1, 3, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
-        |4: ChangeCond(5, 0, 5, c, cond); IF cond = 5 THEN Params[count, 0] := p END
-        |5: ChangeCond(5, 1, 5, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
-        |6:
-        END;
-        INC(p)
-    END;
-    argc := count
-END ParamParse;
-
-
-PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
-    i, j, len: INTEGER;
-    c: CHAR;
-
-BEGIN
-    j := 0;
-    IF n < argc THEN
-        len := LEN(s) - 1;
-        i := Params[n, 0];
-        WHILE (j < len) & (i <= Params[n, 1]) DO
-            c := GetChar(i);
-            IF c # 22X THEN
-                s[j] := c;
-                INC(j)
-            END;
-            INC(i)
-        END
-    END;
-    s[j] := 0X
-END GetArg;
-
-
-PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
-VAR
-    n: INTEGER;
-
-BEGIN
-    n := K.sysfunc4(30, 2, SYSTEM.ADR(path[0]), LEN(path) - 2);
-    path[n - 1] := slash;
-    path[n] := 0X
-END GetCurrentDirectory;
-
-
-PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
-    RETURN path[0] # slash
-END isRelative;
-
-
-PROCEDURE UnixTime* (): INTEGER;
-VAR
-    date, time, year, month, day, hour, min, sec: INTEGER;
-
-BEGIN
-    date  := K.sysfunc1(29);
-    time  := K.sysfunc1(3);
-
-    year  := date MOD 16;
-    date  := date DIV 16;
-    year  := (date MOD 16) * 10 + year;
-    date  := date DIV 16;
-
-    month := date MOD 16;
-    date  := date DIV 16;
-    month := (date MOD 16) * 10 + month;
-    date  := date DIV 16;
-
-    day   := date MOD 16;
-    date  := date DIV 16;
-    day   := (date MOD 16) * 10 + day;
-    date  := date DIV 16;
-
-    hour  := time MOD 16;
-    time  := time DIV 16;
-    hour  := (time MOD 16) * 10 + hour;
-    time  := time DIV 16;
-
-    min   := time MOD 16;
-    time  := time DIV 16;
-    min   := (time MOD 16) * 10 + min;
-    time  := time DIV 16;
-
-    sec   := time MOD 16;
-    time  := time DIV 16;
-    sec   := (time MOD 16) * 10 + sec;
-    time  := time DIV 16;
-
-    INC(year, 2000)
-
-    RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec
-END UnixTime;
-
-
-PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.GET32(SYSTEM.ADR(x), a);
-    SYSTEM.GET32(SYSTEM.ADR(x) + 4, b)
-    RETURN a
-END splitf;
-
-
-PROCEDURE d2s* (x: REAL): INTEGER;
-VAR
-    h, l, s, e: INTEGER;
-
-BEGIN
-    e := splitf(x, l, h);
-
-    s := ASR(h, 31) MOD 2;
-    e := (h DIV 100000H) MOD 2048;
-    IF e <= 896 THEN
-        h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
-        REPEAT
-            h := h DIV 2;
-            INC(e)
-        UNTIL e = 897;
-        e := 896;
-        l := (h MOD 8) * 20000000H;
-        h := h DIV 8
-    ELSIF (1151 <= e) & (e < 2047) THEN
-        e := 1151;
-        h := 0;
-        l := 0
-    ELSIF e = 2047 THEN
-        e := 1151;
-        IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
-            h := 80000H;
-            l := 0
-        END
-    END;
-    DEC(e, 896)
-
-    RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
-END d2s;
-
-
-PROCEDURE init (VAR days: DAYS);
-VAR
-    i, j, n0, n1: INTEGER;
-
-BEGIN
-
-    FOR i := 0 TO 11 DO
-        FOR j := 0 TO 30 DO
-            days[i, j, 0] := 0;
-            days[i, j, 1] := 0;
-        END
-    END;
-
-    days[ 1, 28, 0] := -1;
-
-    FOR i := 0 TO 1 DO
-        days[ 1, 29, i] := -1;
-        days[ 1, 30, i] := -1;
-        days[ 3, 30, i] := -1;
-        days[ 5, 30, i] := -1;
-        days[ 8, 30, i] := -1;
-        days[10, 30, i] := -1;
-    END;
-
-    n0 := 0;
-    n1 := 0;
-    FOR i := 0 TO 11 DO
-        FOR j := 0 TO 30 DO
-            IF days[i, j, 0] = 0 THEN
-                days[i, j, 0] := n0;
-                INC(n0)
-            END;
-            IF days[i, j, 1] = 0 THEN
-                days[i, j, 1] := n1;
-                INC(n1)
-            END
-        END
-    END;
-
-    inf := SYSTEM.INF();
-    maxreal := 1.9;
-    PACK(maxreal, 1023);
-    Console := TRUE;
-    IF Console THEN
-        con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS"))
-    END;
-    ParamParse
-END init;
-
-
-BEGIN
-    init(days)
-END HOST.

programs/develop/oberon07/lib/KolibriOS/In.ob07

@@ -1,282 +0,0 @@
-(*
-    Copyright 2016, 2018 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE In;
-
-IMPORT sys := SYSTEM, ConsoleLib;
-
-TYPE
-
-  STRING = ARRAY 260 OF CHAR;
-
-VAR
-
-  Done* : BOOLEAN;
-
-PROCEDURE digit(ch: CHAR): BOOLEAN;
-  RETURN (ch >= "0") & (ch <= "9")
-END digit;
-
-PROCEDURE CheckInt(s: STRING; VAR first, last: INTEGER; VAR neg: BOOLEAN; Point: BOOLEAN): BOOLEAN;
-VAR i: INTEGER;
-BEGIN
-  i := 0;
-  neg := FALSE;
-  WHILE (s[i] <= 20X) & (s[i] # 0X) DO
-    INC(i)
-  END;
-  IF s[i] = "-" THEN
-    neg := TRUE;
-    INC(i)
-  ELSIF s[i] = "+" THEN
-    INC(i)
-  END;
-  first := i;
-  WHILE digit(s[i]) DO
-    INC(i)
-  END;
-  last := i
-  RETURN ((s[i] <= 20X) OR (Point & (s[i] = "."))) & digit(s[first])
-END CheckInt;
-
-PROCEDURE IsMinInt(str: STRING; pos: INTEGER): BOOLEAN;
-VAR i: INTEGER; min: STRING;
-BEGIN
-  i := 0;
-  min := "2147483648";
-  WHILE (min[i] # 0X) & (str[i] # 0X) & (min[i] = str[i + pos]) DO
-    INC(i)
-  END
-  RETURN i = 10
-END IsMinInt;
-
-PROCEDURE StrToInt(str: STRING; VAR err: BOOLEAN): INTEGER;
-CONST maxINT = 7FFFFFFFH;
-VAR i, n, res: INTEGER; flag, neg: BOOLEAN;
-BEGIN
-  res := 0;
-  flag := CheckInt(str, i, n, neg, FALSE);
-  err := ~flag;
-  IF flag & neg & IsMinInt(str, i) THEN
-    flag := FALSE;
-    neg := FALSE;
-    res := 80000000H
-  END;
-  WHILE flag & digit(str[i]) DO
-    IF res > maxINT DIV 10 THEN
-      err := TRUE;
-      flag := FALSE;
-      res := 0
-    ELSE
-      res := res * 10;
-      IF res > maxINT - (ORD(str[i]) - ORD("0")) THEN
-        err := TRUE;
-        flag := FALSE;
-        res := 0
-      ELSE
-        res := res + (ORD(str[i]) - ORD("0"));
-        INC(i)
-      END
-    END
-  END;
-  IF neg THEN
-    res := -res
-  END
-  RETURN res
-END StrToInt;
-
-PROCEDURE Space(s: STRING): BOOLEAN;
-VAR i: INTEGER;
-BEGIN
-  i := 0;
-  WHILE (s[i] # 0X) & (s[i] <= 20X) DO
-    INC(i)
-  END
-  RETURN s[i] = 0X
-END Space;
-
-PROCEDURE CheckReal(s: STRING; VAR n: INTEGER; VAR neg: BOOLEAN): BOOLEAN;
-VAR i: INTEGER; Res: BOOLEAN;
-BEGIN
-  Res := CheckInt(s, n, i, neg, TRUE);
-  IF Res THEN
-    IF s[i] = "." THEN
-      INC(i);
-      WHILE digit(s[i]) DO
-        INC(i)
-      END;
-      IF (s[i] = "D") OR (s[i] = "E") OR (s[i] = "d") OR (s[i] = "e") THEN
-        INC(i);
-        IF (s[i] = "+") OR (s[i] = "-") THEN
-          INC(i)
-        END;
-        Res := digit(s[i]);
-        WHILE digit(s[i]) DO
-          INC(i)
-        END
-      END
-    END
-  END
-  RETURN Res & (s[i] <= 20X)
-END CheckReal;
-
-PROCEDURE StrToFloat(str: STRING; VAR err: BOOLEAN): REAL;
-CONST maxDBL = 1.69E308; maxINT = 7FFFFFFFH;
-VAR i, scale: INTEGER; res, m, d: REAL; minus, neg: BOOLEAN;
-
-  PROCEDURE part1 (str: STRING; VAR res, d: REAL; VAR i: INTEGER): BOOLEAN;
-  BEGIN
-    res := 0.0;
-    d := 1.0;
-    WHILE digit(str[i]) DO
-      res := res * 10.0 + FLT(ORD(str[i]) - ORD("0"));
-      INC(i)
-    END;
-    IF str[i] = "." THEN
-      INC(i);
-      WHILE digit(str[i]) DO
-        d := d / 10.0;
-        res := res + FLT(ORD(str[i]) - ORD("0")) * d;
-        INC(i)
-      END
-    END
-    RETURN str[i] # 0X
-  END part1;
-
-  PROCEDURE part2 (str: STRING; VAR i, scale: INTEGER; VAR minus, err: BOOLEAN; VAR m, res: REAL): BOOLEAN;
-  BEGIN
-    INC(i);
-    m := 10.0;
-    minus := FALSE;
-    IF str[i] = "+" THEN
-      INC(i)
-    ELSIF str[i] = "-" THEN
-      minus := TRUE;
-      INC(i);
-      m := 0.1
-    END;
-    scale := 0;
-    err := FALSE;
-    WHILE ~err & digit(str[i]) DO
-      IF scale > maxINT DIV 10 THEN
-        err := TRUE;
-        res := 0.0
-      ELSE
-        scale := scale * 10;
-        IF scale > maxINT - (ORD(str[i]) - ORD("0")) THEN
-          err := TRUE;
-          res := 0.0
-        ELSE
-          scale := scale + (ORD(str[i]) - ORD("0"));
-          INC(i)
-        END
-      END
-    END
-    RETURN ~err
-  END part2;
-
-  PROCEDURE part3 (VAR err, minus: BOOLEAN; VAR res, m: REAL; VAR scale: INTEGER);
-  VAR i: INTEGER;
-  BEGIN
-    err := FALSE;
-    IF scale = maxINT THEN
-      err := TRUE;
-      res := 0.0
-    END;
-    i := 1;
-    WHILE ~err & (i <= scale) DO
-      IF ~minus & (res > maxDBL / m) THEN
-        err := TRUE;
-        res := 0.0
-      ELSE
-        res := res * m;
-        INC(i)
-      END
-    END
-  END part3;
-
-BEGIN
-  IF CheckReal(str, i, neg) THEN
-    IF part1(str, res, d, i) & part2(str, i, scale, minus, err, m, res) THEN
-      part3(err, minus, res, m, scale)
-    END;
-    IF neg THEN
-      res := -res
-    END
-  ELSE
-    res := 0.0;
-    err := TRUE
-  END
-  RETURN res
-END StrToFloat;
-
-PROCEDURE String*(VAR s: ARRAY OF CHAR);
-VAR res, length: INTEGER; str: STRING;
-BEGIN
-  res := ConsoleLib.gets(sys.ADR(str[0]), LEN(str));
-  length := LENGTH(str);
-  IF length > 0 THEN
-    str[length - 1] := 0X
-  END;
-  COPY(str, s);
-  Done := TRUE
-END String;
-
-PROCEDURE Char*(VAR x: CHAR);
-VAR str: STRING;
-BEGIN
-  String(str);
-  x := str[0];
-  Done := TRUE
-END Char;
-
-PROCEDURE Ln*;
-VAR str: STRING;
-BEGIN
-  String(str);
-  Done := TRUE
-END Ln;
-
-PROCEDURE Real* (VAR x: REAL);
-VAR str: STRING; err: BOOLEAN;
-BEGIN
-  err := FALSE;
-  REPEAT
-    String(str)
-  UNTIL ~Space(str);
-  x := StrToFloat(str, err);
-  Done := ~err
-END Real;
-
-
-PROCEDURE Int*(VAR x: INTEGER);
-VAR str: STRING; err: BOOLEAN;
-BEGIN
-  err := FALSE;
-  REPEAT
-    String(str)
-  UNTIL ~Space(str);
-  x := StrToInt(str, err);
-  Done := ~err
-END Int;
-
-PROCEDURE Open*;
-BEGIN
-  Done := TRUE
-END Open;
-
-END In.

programs/develop/oberon07/lib/KolibriOS/KOSAPI.ob07

@@ -1,436 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2019, 2022 Anton Krotov
-    All rights reserved.
-*)
-
-MODULE KOSAPI;
-
-IMPORT SYSTEM;
-
-
-TYPE
-
-    STRING = ARRAY 1024 OF CHAR;
-
-
-VAR
-
-    DLL_INIT: PROCEDURE [stdcall] (entry: INTEGER);
-
-
-PROCEDURE [stdcall-] sysfunc1* (arg1: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(
-    08BH, 045H, 008H,   (*  mov     eax, dword [ebp + 8]   *)
-    0CDH, 040H,         (*  int     64                     *)
-    0C9H,               (*  leave                          *)
-    0C2H, 004H, 000H    (*  ret     4                      *)
-    )
-    RETURN 0
-END sysfunc1;
-
-
-PROCEDURE [stdcall-] sysfunc2* (arg1, arg2: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(
-    053H,               (*  push    ebx                    *)
-    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
-    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
-    0CDH, 040H,         (*  int     64                     *)
-    05BH,               (*  pop     ebx                    *)
-    0C9H,               (*  leave                          *)
-    0C2H, 008H, 000H    (*  ret     8                      *)
-    )
-    RETURN 0
-END sysfunc2;
-
-
-PROCEDURE [stdcall-] sysfunc3* (arg1, arg2, arg3: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(
-    053H,               (*  push    ebx                    *)
-    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
-    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
-    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
-    0CDH, 040H,         (*  int     64                     *)
-    05BH,               (*  pop     ebx                    *)
-    0C9H,               (*  leave                          *)
-    0C2H, 00CH, 000H    (*  ret     12                     *)
-    )
-    RETURN 0
-END sysfunc3;
-
-
-PROCEDURE [stdcall-] sysfunc4* (arg1, arg2, arg3, arg4: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(
-    053H,               (*  push    ebx                    *)
-    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
-    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
-    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
-    08BH, 055H, 014H,   (*  mov     edx, dword [ebp + 20]  *)
-    0CDH, 040H,         (*  int     64                     *)
-    05BH,               (*  pop     ebx                    *)
-    0C9H,               (*  leave                          *)
-    0C2H, 010H, 000H    (*  ret     16                     *)
-    )
-    RETURN 0
-END sysfunc4;
-
-
-PROCEDURE [stdcall-] sysfunc5* (arg1, arg2, arg3, arg4, arg5: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(
-    053H,               (*  push    ebx                    *)
-    056H,               (*  push    esi                    *)
-    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
-    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
-    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
-    08BH, 055H, 014H,   (*  mov     edx, dword [ebp + 20]  *)
-    08BH, 075H, 018H,   (*  mov     esi, dword [ebp + 24]  *)
-    0CDH, 040H,         (*  int     64                     *)
-    05EH,               (*  pop     esi                    *)
-    05BH,               (*  pop     ebx                    *)
-    0C9H,               (*  leave                          *)
-    0C2H, 014H, 000H    (*  ret     20                     *)
-    )
-    RETURN 0
-END sysfunc5;
-
-
-PROCEDURE [stdcall-] sysfunc6* (arg1, arg2, arg3, arg4, arg5, arg6: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(
-    053H,               (*  push    ebx                    *)
-    056H,               (*  push    esi                    *)
-    057H,               (*  push    edi                    *)
-    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
-    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
-    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
-    08BH, 055H, 014H,   (*  mov     edx, dword [ebp + 20]  *)
-    08BH, 075H, 018H,   (*  mov     esi, dword [ebp + 24]  *)
-    08BH, 07DH, 01CH,   (*  mov     edi, dword [ebp + 28]  *)
-    0CDH, 040H,         (*  int     64                     *)
-    05FH,               (*  pop     edi                    *)
-    05EH,               (*  pop     esi                    *)
-    05BH,               (*  pop     ebx                    *)
-    0C9H,               (*  leave                          *)
-    0C2H, 018H, 000H    (*  ret     24                     *)
-    )
-    RETURN 0
-END sysfunc6;
-
-
-PROCEDURE [stdcall-] sysfunc7* (arg1, arg2, arg3, arg4, arg5, arg6, arg7: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(
-    053H,               (*  push    ebx                    *)
-    056H,               (*  push    esi                    *)
-    057H,               (*  push    edi                    *)
-    055H,               (*  push    ebp                    *)
-    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
-    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
-    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
-    08BH, 055H, 014H,   (*  mov     edx, dword [ebp + 20]  *)
-    08BH, 075H, 018H,   (*  mov     esi, dword [ebp + 24]  *)
-    08BH, 07DH, 01CH,   (*  mov     edi, dword [ebp + 28]  *)
-    08BH, 06DH, 020H,   (*  mov     ebp, dword [ebp + 32]  *)
-    0CDH, 040H,         (*  int     64                     *)
-    05DH,               (*  pop     ebp                    *)
-    05FH,               (*  pop     edi                    *)
-    05EH,               (*  pop     esi                    *)
-    05BH,               (*  pop     ebx                    *)
-    0C9H,               (*  leave                          *)
-    0C2H, 01CH, 000H    (*  ret     28                     *)
-    )
-    RETURN 0
-END sysfunc7;
-
-
-PROCEDURE [stdcall-] sysfunc22* (arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(
-    053H,               (*  push    ebx                    *)
-    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
-    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
-    0CDH, 040H,         (*  int     64                     *)
-    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
-    089H, 019H,         (*  mov     dword [ecx], ebx       *)
-    05BH,               (*  pop     ebx                    *)
-    0C9H,               (*  leave                          *)
-    0C2H, 00CH, 000H    (*  ret     12                     *)
-    )
-    RETURN 0
-END sysfunc22;
-
-
-PROCEDURE mem_commit (adr, size: INTEGER);
-VAR
-    tmp: INTEGER;
-BEGIN
-    FOR tmp := adr TO adr + size - 1 BY 4096 DO
-        SYSTEM.PUT(tmp, 0)
-    END
-END mem_commit;
-
-
-PROCEDURE [stdcall] malloc* (size: INTEGER): INTEGER;
-VAR
-    ptr: INTEGER;
-BEGIN
-    SYSTEM.CODE(060H); (* pusha *)
-    IF sysfunc2(18, 16) > ASR(size, 10) THEN
-        ptr := sysfunc3(68, 12, size);
-        IF ptr # 0 THEN
-            mem_commit(ptr, size)
-        END
-    ELSE
-        ptr := 0
-    END;
-    SYSTEM.CODE(061H)  (* popa  *)
-    RETURN ptr
-END malloc;
-
-
-PROCEDURE [stdcall] free* (ptr: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(060H); (* pusha *)
-    IF ptr # 0 THEN
-        ptr := sysfunc3(68, 13, ptr)
-    END;
-    SYSTEM.CODE(061H)  (* popa  *)
-    RETURN 0
-END free;
-
-
-PROCEDURE [stdcall] realloc* (ptr, size: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(060H); (* pusha *)
-    ptr := sysfunc4(68, 20, size, ptr);
-    SYSTEM.CODE(061H)  (* popa  *)
-    RETURN ptr
-END realloc;
-
-
-PROCEDURE AppAdr (): INTEGER;
-VAR
-    buf: ARRAY 1024 OF CHAR;
-    a: INTEGER;
-BEGIN
-    a := sysfunc3(9, SYSTEM.ADR(buf), -1);
-    SYSTEM.GET(SYSTEM.ADR(buf) + 22, a)
-    RETURN a
-END AppAdr;
-
-
-PROCEDURE GetCommandLine* (): INTEGER;
-VAR
-    param: INTEGER;
-BEGIN
-    SYSTEM.GET(28 + AppAdr(), param)
-    RETURN param
-END GetCommandLine;
-
-
-PROCEDURE GetName* (): INTEGER;
-VAR
-    name: INTEGER;
-BEGIN
-    SYSTEM.GET(32 + AppAdr(), name)
-    RETURN name
-END GetName;
-
-
-PROCEDURE [stdcall] dll_init2 (arg1, arg2, arg3, arg4, arg5: INTEGER);
-BEGIN
-    SYSTEM.CODE(
-    060H,               (*  pusha                          *)
-    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
-    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
-    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
-    08BH, 055H, 014H,   (*  mov     edx, dword [ebp + 20]  *)
-    08BH, 075H, 018H,   (*  mov     esi, dword [ebp + 24]  *)
-    0FFH, 0D6H,         (*  call    esi                    *)
-    061H,               (*  popa                           *)
-    0C9H,               (*  leave                          *)
-    0C2H, 014H, 000H    (*  ret     20                     *)
-    )
-END dll_init2;
-
-
-PROCEDURE GetProcAdr* (name: ARRAY OF CHAR; lib: INTEGER): INTEGER;
-VAR
-    cur, procname, adr: INTEGER;
-
-    PROCEDURE streq (str1, str2: INTEGER): BOOLEAN;
-    VAR
-        c1, c2: CHAR;
-    BEGIN
-        REPEAT
-            SYSTEM.GET(str1, c1);
-            SYSTEM.GET(str2, c2);
-            INC(str1);
-            INC(str2)
-        UNTIL (c1 # c2) OR (c1 = 0X)
-
-        RETURN c1 = c2
-    END streq;
-
-BEGIN
-    adr := 0;
-    IF (lib # 0) & (name # "") THEN
-        cur := lib;
-        REPEAT
-            SYSTEM.GET(cur, procname);
-            INC(cur, 8)
-        UNTIL (procname = 0) OR streq(procname, SYSTEM.ADR(name[0]));
-        IF procname # 0 THEN
-            SYSTEM.GET(cur - 4, adr)
-        END
-    END
-
-    RETURN adr
-END GetProcAdr;
-
-
-PROCEDURE init (dll: INTEGER);
-VAR
-    lib_init: INTEGER;
-BEGIN
-    lib_init := GetProcAdr("lib_init", dll);
-    IF lib_init # 0 THEN
-        DLL_INIT(lib_init)
-    END;
-    lib_init := GetProcAdr("START", dll);
-    IF lib_init # 0 THEN
-        DLL_INIT(lib_init)
-    END
-END init;
-
-
-PROCEDURE OutChar* (c: CHAR);
-BEGIN
-    sysfunc3(63, 1, ORD(c))
-END OutChar;
-
-
-PROCEDURE OutLn*;
-BEGIN
-    OutChar(0DX);
-    OutChar(0AX)
-END OutLn;
-
-
-PROCEDURE OutString (s: ARRAY OF CHAR);
-VAR
-    i: INTEGER;
-BEGIN
-    i := 0;
-    WHILE (i < LEN(s)) & (s[i] # 0X) DO
-        OutChar(s[i]);
-        INC(i)
-    END
-END OutString;
-
-
-PROCEDURE imp_error (lib, proc: STRING);
-BEGIN
-    OutString("import error: ");
-    IF proc = "" THEN
-        OutString("can't load '")
-    ELSE
-        OutString("not found '"); OutString(proc); OutString("' in '")
-    END;
-    OutString(lib);
-    OutString("'" + 0DX + 0AX)
-END imp_error;
-
-
-PROCEDURE GetStr (adr, i: INTEGER; VAR str: STRING);
-VAR
-    c: CHAR;
-BEGIN
-    REPEAT
-        SYSTEM.GET(adr, c); INC(adr);
-        str[i] := c; INC(i)
-    UNTIL c = 0X
-END GetStr;
-
-
-PROCEDURE [stdcall-] dll_Load* (import_table: INTEGER): INTEGER;
-CONST
-	path = "/sys/lib/";
-VAR
-    imp, lib, exp, proc, pathLen: INTEGER;
-    procname, libname: STRING;
-BEGIN
-    SYSTEM.CODE(060H); (* pusha *)
-    libname := path;
-    pathLen := LENGTH(libname);
-
-    SYSTEM.GET(import_table, imp);
-    WHILE imp # 0 DO
-        SYSTEM.GET(import_table + 4, lib);
-        GetStr(lib, pathLen, libname);
-        exp := sysfunc3(68, 19, SYSTEM.ADR(libname[0]));
-        IF exp = 0 THEN
-            imp_error(libname, "")
-        ELSE
-            REPEAT
-                SYSTEM.GET(imp, proc);
-                IF proc # 0 THEN
-                    GetStr(proc, 0, procname);
-                    proc := GetProcAdr(procname, exp);
-                    IF proc # 0 THEN
-                        SYSTEM.PUT(imp, proc)
-                    ELSE
-                    	proc := 1;
-                        imp_error(libname, procname)
-                    END;
-                    INC(imp, 4)
-                END
-            UNTIL proc = 0;
-            init(exp)
-        END;
-        INC(import_table, 8);
-        SYSTEM.GET(import_table, imp);
-    END;
-
-    SYSTEM.CODE(061H) (* popa *)
-    RETURN 0
-END dll_Load;
-
-
-PROCEDURE [stdcall] dll_Init (entry: INTEGER);
-BEGIN
-    SYSTEM.CODE(060H); (* pusha *)
-    IF entry # 0 THEN
-        dll_init2(SYSTEM.ADR(malloc), SYSTEM.ADR(free), SYSTEM.ADR(realloc), SYSTEM.ADR(dll_Load), entry)
-    END;
-    SYSTEM.CODE(061H); (* popa  *)
-END dll_Init;
-
-
-PROCEDURE LoadLib* (name: ARRAY OF CHAR): INTEGER;
-VAR
-    Lib: INTEGER;
-BEGIN
-    DLL_INIT := dll_Init;
-    Lib := sysfunc3(68, 19, SYSTEM.ADR(name[0]));
-    IF Lib # 0 THEN
-        init(Lib)
-    END
-    RETURN Lib
-END LoadLib;
-
-
-PROCEDURE _init* (import_table: INTEGER);
-BEGIN
-    DLL_INIT := dll_Init;
-    dll_Load(import_table)
-END _init;
-
-
-END KOSAPI.

programs/develop/oberon07/lib/KolibriOS/Math.ob07

@@ -1,449 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2013-2014, 2018-2022 Anton Krotov
-    All rights reserved.
-*)
-
-MODULE Math;
-
-IMPORT SYSTEM;
-
-
-CONST
-
-    pi* = 3.141592653589793;
-    e*  = 2.718281828459045;
-
-
-PROCEDURE IsNan* (x: REAL): BOOLEAN;
-VAR
-    h, l: SET;
-
-BEGIN
-    SYSTEM.GET(SYSTEM.ADR(x), l);
-    SYSTEM.GET(SYSTEM.ADR(x) + 4, h)
-    RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
-END IsNan;
-
-
-PROCEDURE IsInf* (x: REAL): BOOLEAN;
-    RETURN ABS(x) = SYSTEM.INF()
-END IsInf;
-
-
-PROCEDURE Max (a, b: REAL): REAL;
-VAR
-    res: REAL;
-
-BEGIN
-    IF a > b THEN
-        res := a
-    ELSE
-        res := b
-    END
-    RETURN res
-END Max;
-
-
-PROCEDURE Min (a, b: REAL): REAL;
-VAR
-    res: REAL;
-
-BEGIN
-    IF a < b THEN
-        res := a
-    ELSE
-        res := b
-    END
-    RETURN res
-END Min;
-
-
-PROCEDURE SameValue (a, b: REAL): BOOLEAN;
-VAR
-    eps: REAL;
-    res: BOOLEAN;
-
-BEGIN
-    eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12);
-    IF a > b THEN
-        res := (a - b) <= eps
-    ELSE
-        res := (b - a) <= eps
-    END
-    RETURN res
-END SameValue;
-
-
-PROCEDURE IsZero (x: REAL): BOOLEAN;
-    RETURN ABS(x) <= 1.0E-12
-END IsZero;
-
-
-PROCEDURE [stdcall] sqrt* (x: REAL): REAL;
-BEGIN
-    SYSTEM.CODE(
-    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
-    0D9H, 0FAH,                    (*  fsqrt                      *)
-    0C9H,                          (*  leave                      *)
-    0C2H, 008H, 000H               (*  ret     08h                *)
-    )
-    RETURN 0.0
-END sqrt;
-
-
-PROCEDURE [stdcall] sin* (x: REAL): REAL;
-BEGIN
-    SYSTEM.CODE(
-    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
-    0D9H, 0FEH,                    (*  fsin                       *)
-    0C9H,                          (*  leave                      *)
-    0C2H, 008H, 000H               (*  ret     08h                *)
-    )
-    RETURN 0.0
-END sin;
-
-
-PROCEDURE [stdcall] cos* (x: REAL): REAL;
-BEGIN
-    SYSTEM.CODE(
-    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
-    0D9H, 0FFH,                    (*  fcos                       *)
-    0C9H,                          (*  leave                      *)
-    0C2H, 008H, 000H               (*  ret     08h                *)
-    )
-    RETURN 0.0
-END cos;
-
-
-PROCEDURE [stdcall] tan* (x: REAL): REAL;
-BEGIN
-    SYSTEM.CODE(
-    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
-    0D9H, 0FBH,                    (*  fsincos                    *)
-    0DEH, 0F9H,                    (*  fdivp st1, st              *)
-    0C9H,                          (*  leave                      *)
-    0C2H, 008H, 000H               (*  ret     08h                *)
-    )
-    RETURN 0.0
-END tan;
-
-
-PROCEDURE [stdcall] arctan2* (y, x: REAL): REAL;
-BEGIN
-    SYSTEM.CODE(
-    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
-    0DDH, 045H, 010H,              (*  fld     qword [ebp + 10h]  *)
-    0D9H, 0F3H,                    (*  fpatan                     *)
-    0C9H,                          (*  leave                      *)
-    0C2H, 010H, 000H               (*  ret     10h                *)
-    )
-    RETURN 0.0
-END arctan2;
-
-
-PROCEDURE [stdcall] ln* (x: REAL): REAL;
-BEGIN
-    SYSTEM.CODE(
-    0D9H, 0EDH,                    (*  fldln2                     *)
-    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
-    0D9H, 0F1H,                    (*  fyl2x                      *)
-    0C9H,                          (*  leave                      *)
-    0C2H, 008H, 000H               (*  ret     08h                *)
-    )
-    RETURN 0.0
-END ln;
-
-
-PROCEDURE [stdcall] log* (base, x: REAL): REAL;
-BEGIN
-    SYSTEM.CODE(
-    0D9H, 0E8H,                    (*  fld1                       *)
-    0DDH, 045H, 010H,              (*  fld     qword [ebp + 10h]  *)
-    0D9H, 0F1H,                    (*  fyl2x                      *)
-    0D9H, 0E8H,                    (*  fld1                       *)
-    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
-    0D9H, 0F1H,                    (*  fyl2x                      *)
-    0DEH, 0F9H,                    (*  fdivp st1, st              *)
-    0C9H,                          (*  leave                      *)
-    0C2H, 010H, 000H               (*  ret     10h                *)
-    )
-    RETURN 0.0
-END log;
-
-
-PROCEDURE [stdcall] exp* (x: REAL): REAL;
-BEGIN
-    SYSTEM.CODE(
-    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
-    0D9H, 0EAH,                 (*  fldl2e                     *)
-    0DEH, 0C9H, 0D9H, 0C0H,
-    0D9H, 0FCH, 0DCH, 0E9H,
-    0D9H, 0C9H, 0D9H, 0F0H,
-    0D9H, 0E8H, 0DEH, 0C1H,
-    0D9H, 0FDH, 0DDH, 0D9H,
-    0C9H,                       (*  leave                      *)
-    0C2H, 008H, 000H            (*  ret     08h                *)
-    )
-    RETURN 0.0
-END exp;
-
-
-PROCEDURE [stdcall] round* (x: REAL): REAL;
-BEGIN
-    SYSTEM.CODE(
-    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
-    0D9H, 07DH, 0F4H, 0D9H,
-    07DH, 0F6H, 066H, 081H,
-    04DH, 0F6H, 000H, 003H,
-    0D9H, 06DH, 0F6H, 0D9H,
-    0FCH, 0D9H, 06DH, 0F4H,
-    0C9H,                       (*  leave                     *)
-    0C2H, 008H, 000H            (*  ret     08h               *)
-    )
-    RETURN 0.0
-END round;
-
-
-PROCEDURE [stdcall] frac* (x: REAL): REAL;
-BEGIN
-    SYSTEM.CODE(
-    050H,
-    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
-    0D9H, 0C0H, 0D9H, 03CH,
-    024H, 0D9H, 07CH, 024H,
-    002H, 066H, 081H, 04CH,
-    024H, 002H, 000H, 00FH,
-    0D9H, 06CH, 024H, 002H,
-    0D9H, 0FCH, 0D9H, 02CH,
-    024H, 0DEH, 0E9H,
-    0C9H,                       (*  leave                     *)
-    0C2H, 008H, 000H            (*  ret     08h               *)
-    )
-    RETURN 0.0
-END frac;
-
-
-PROCEDURE sqri* (x: INTEGER): INTEGER;
-    RETURN x * x
-END sqri;
-
-
-PROCEDURE sqrr* (x: REAL): REAL;
-    RETURN x * x
-END sqrr;
-
-
-PROCEDURE arcsin* (x: REAL): REAL;
-    RETURN arctan2(x, sqrt(1.0 - x * x))
-END arcsin;
-
-
-PROCEDURE arccos* (x: REAL): REAL;
-    RETURN arctan2(sqrt(1.0 - x * x), x)
-END arccos;
-
-
-PROCEDURE arctan* (x: REAL): REAL;
-    RETURN arctan2(x, 1.0)
-END arctan;
-
-
-PROCEDURE sinh* (x: REAL): REAL;
-BEGIN
-    x := exp(x)
-    RETURN (x - 1.0 / x) * 0.5
-END sinh;
-
-
-PROCEDURE cosh* (x: REAL): REAL;
-BEGIN
-    x := exp(x)
-    RETURN (x + 1.0 / x) * 0.5
-END cosh;
-
-
-PROCEDURE tanh* (x: REAL): REAL;
-BEGIN
-    IF x > 15.0 THEN
-        x := 1.0
-    ELSIF x < -15.0 THEN
-        x := -1.0
-    ELSE
-        x := 1.0 - 2.0 / (exp(2.0 * x) + 1.0)
-    END
-
-    RETURN x
-END tanh;
-
-
-PROCEDURE arsinh* (x: REAL): REAL;
-    RETURN ln(x + sqrt(x * x + 1.0))
-END arsinh;
-
-
-PROCEDURE arcosh* (x: REAL): REAL;
-    RETURN ln(x + sqrt(x * x - 1.0))
-END arcosh;
-
-
-PROCEDURE artanh* (x: REAL): REAL;
-VAR
-    res: REAL;
-
-BEGIN
-    IF SameValue(x, 1.0) THEN
-        res := SYSTEM.INF()
-    ELSIF SameValue(x, -1.0) THEN
-        res := -SYSTEM.INF()
-    ELSE
-        res := 0.5 * ln((1.0 + x) / (1.0 - x))
-    END
-    RETURN res
-END artanh;
-
-
-PROCEDURE floor* (x: REAL): REAL;
-VAR
-    f: REAL;
-
-BEGIN
-    f := frac(x);
-    x := x - f;
-    IF f < 0.0 THEN
-        x := x - 1.0
-    END
-    RETURN x
-END floor;
-
-
-PROCEDURE ceil* (x: REAL): REAL;
-VAR
-    f: REAL;
-
-BEGIN
-    f := frac(x);
-    x := x - f;
-    IF f > 0.0 THEN
-        x := x + 1.0
-    END
-    RETURN x
-END ceil;
-
-
-PROCEDURE power* (base, exponent: REAL): REAL;
-VAR
-    res: REAL;
-
-BEGIN
-    IF exponent = 0.0 THEN
-        res := 1.0
-    ELSIF (base = 0.0) & (exponent > 0.0) THEN
-        res := 0.0
-    ELSE
-        res := exp(exponent * ln(base))
-    END
-    RETURN res
-END power;
-
-
-PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL;
-VAR
-    i: INTEGER;
-    a: REAL;
-
-BEGIN
-    a := 1.0;
-
-    IF base # 0.0 THEN
-        IF exponent # 0 THEN
-            IF exponent < 0 THEN
-                base := 1.0 / base
-            END;
-            i := ABS(exponent);
-            WHILE i > 0 DO
-                WHILE ~ODD(i) DO
-                    i := LSR(i, 1);
-                    base := sqrr(base)
-                END;
-                DEC(i);
-                a := a * base
-            END
-        ELSE
-            a := 1.0
-        END
-    ELSE
-        ASSERT(exponent > 0);
-        a := 0.0
-    END
-
-    RETURN a
-END ipower;
-
-
-PROCEDURE sgn* (x: REAL): INTEGER;
-VAR
-    res: INTEGER;
-
-BEGIN
-    IF x > 0.0 THEN
-        res := 1
-    ELSIF x < 0.0 THEN
-        res := -1
-    ELSE
-        res := 0
-    END
-
-    RETURN res
-END sgn;
-
-
-PROCEDURE fact* (n: INTEGER): REAL;
-VAR
-    res: REAL;
-
-BEGIN
-    res := 1.0;
-    WHILE n > 1 DO
-        res := res * FLT(n);
-        DEC(n)
-    END
-
-    RETURN res
-END fact;
-
-
-PROCEDURE DegToRad* (x: REAL): REAL;
-    RETURN x * (pi / 180.0)
-END DegToRad;
-
-
-PROCEDURE RadToDeg* (x: REAL): REAL;
-    RETURN x * (180.0 / pi)
-END RadToDeg;
-
-
-(* Return hypotenuse of triangle *)
-PROCEDURE hypot* (x, y: REAL): REAL;
-VAR
-    a: REAL;
-
-BEGIN
-    x := ABS(x);
-    y := ABS(y);
-    IF x > y THEN
-        a := x * sqrt(1.0 + sqrr(y / x))
-    ELSE
-        IF x > 0.0 THEN
-            a := y * sqrt(1.0 + sqrr(x / y))
-        ELSE
-            a := y
-        END
-    END
-
-    RETURN a
-END hypot;
-
-
-END Math.

programs/develop/oberon07/lib/KolibriOS/NetDevices.ob07

@@ -1,107 +0,0 @@
-(*
-    Copyright 2017 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE NetDevices;
-
-IMPORT sys := SYSTEM, K := KOSAPI;
-
-
-CONST
-
-  //net devices types
-
-  LOOPBACK*        = 0;
-  ETH*             = 1;
-  SLIP*            = 2;
-
-  //Link status
-
-  LINK_DOWN*       = 0;
-  LINK_UNKNOWN*    = 1;
-  LINK_FD*         = 2; //full duplex flag
-  LINK_10M*        = 4;
-  LINK_100M*       = 8;
-  LINK_1G*         = 12;
-
-
-TYPE
-
-  DEVICENAME* = ARRAY 64 OF CHAR;
-
-
-PROCEDURE Number* (): INTEGER;
-  RETURN K.sysfunc2(74, -1)
-END Number;
-
-
-PROCEDURE Type* (num: INTEGER): INTEGER;
-  RETURN K.sysfunc2(74, num * 256)
-END Type;
-
-
-PROCEDURE Name* (num: INTEGER; VAR name: DEVICENAME): BOOLEAN;
-VAR err: BOOLEAN;
-BEGIN
-  err := K.sysfunc3(74, num * 256 + 1, sys.ADR(name[0])) = -1;
-  IF err THEN
-    name := ""
-  END
-  RETURN ~err
-END Name;
-
-
-PROCEDURE Reset* (num: INTEGER): BOOLEAN;
-  RETURN K.sysfunc2(74, num * 256 + 2) # -1
-END Reset;
-
-
-PROCEDURE Stop* (num: INTEGER): BOOLEAN;
-  RETURN K.sysfunc2(74, num * 256 + 3) # -1
-END Stop;
-
-
-PROCEDURE Pointer* (num: INTEGER): INTEGER;
-  RETURN K.sysfunc2(74, num * 256 + 4)
-END Pointer;
-
-
-PROCEDURE SentPackets* (num: INTEGER): INTEGER;
-  RETURN K.sysfunc2(74, num * 256 + 6)
-END SentPackets;
-
-
-PROCEDURE ReceivedPackets* (num: INTEGER): INTEGER;
-  RETURN K.sysfunc2(74, num * 256 + 7)
-END ReceivedPackets;
-
-
-PROCEDURE SentBytes* (num: INTEGER; VAR hValue: INTEGER): INTEGER;
-  RETURN K.sysfunc22(74, num * 256 + 8, hValue)
-END SentBytes;
-
-
-PROCEDURE ReceivedBytes* (num: INTEGER; VAR hValue: INTEGER): INTEGER;
-  RETURN K.sysfunc22(74, num * 256 + 9, hValue)
-END ReceivedBytes;
-
-
-PROCEDURE LinkStatus* (num: INTEGER): INTEGER;
-  RETURN K.sysfunc2(74, num * 256 + 10)
-END LinkStatus;
-
-
-END NetDevices.

programs/develop/oberon07/lib/KolibriOS/OpenDlg.ob07

@@ -1,158 +0,0 @@
-(*
-    Copyright 2016, 2018, 2020-2022 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE OpenDlg;
-
-IMPORT sys := SYSTEM, KOSAPI;
-
-CONST
-  topen* = 0;
-  tsave* = 1;
-  tdir* = 2;
-
-TYPE
-
-  DRAW_WINDOW = PROCEDURE;
-
-  TDialog = RECORD
-    _type*,
-    procinfo,
-    com_area_name,
-    com_area,
-    opendir_path,
-    dir_default_path,
-    start_path: INTEGER;
-    draw_window: DRAW_WINDOW;
-    status*,
-    openfile_path,
-    filename_area: INTEGER;
-    filter_area:
-      POINTER TO RECORD
-        size: INTEGER;
-        filter: ARRAY 4096 OF CHAR
-      END;
-    X, Y: INTEGER;
-
-    procinf: ARRAY 1024 OF CHAR;
-    s_com_area_name: ARRAY 32 OF CHAR;
-    s_opendir_path,
-    s_dir_default_path,
-    FilePath*,
-    FileName*: ARRAY 4096 OF CHAR
-  END;
-
-  Dialog* = POINTER TO TDialog;
-
-VAR
-
-  Dialog_start, Dialog_init: PROCEDURE [stdcall] (od: Dialog);
-
-
-PROCEDURE Show*(od: Dialog; Width, Height: INTEGER);
-BEGIN
-  IF od # NIL THEN
-    od.X := Width;
-    od.Y := Height;
-    Dialog_start(od)
-  END
-END Show;
-
-PROCEDURE Create*(draw_window: DRAW_WINDOW; _type: INTEGER; def_path, filter: ARRAY OF CHAR): Dialog;
-VAR res: Dialog; n, i: INTEGER;
-
-  PROCEDURE replace(VAR str: ARRAY OF CHAR; c1, c2: CHAR);
-  VAR i: INTEGER;
-  BEGIN
-    i := LENGTH(str) - 1;
-    WHILE i >= 0 DO
-      IF str[i] = c1 THEN
-        str[i] := c2
-      END;
-      DEC(i)
-    END
-  END replace;
-
-BEGIN
-  NEW(res);
-  IF res # NIL THEN
-    NEW(res.filter_area);
-    IF res.filter_area # NIL THEN
-      res.s_com_area_name    := "FFFFFFFF_open_dialog";
-      res.com_area           := 0;
-      res._type              := _type;
-      res.draw_window        := draw_window;
-      COPY(def_path, res.s_dir_default_path);
-      COPY(filter,   res.filter_area.filter);
-
-      n := LENGTH(res.filter_area.filter);
-      FOR i := 0 TO 3 DO
-        res.filter_area.filter[n + i] := "|"
-      END;
-      res.filter_area.filter[n + 4] := 0X;
-
-      res.X                  := 0;
-      res.Y                  := 0;
-      res.s_opendir_path     := res.s_dir_default_path;
-      res.FilePath           := "";
-      res.FileName           := "";
-      res.status             := 0;
-      res.filter_area.size   := LENGTH(res.filter_area.filter);
-      res.procinfo           := sys.ADR(res.procinf[0]);
-      res.com_area_name      := sys.ADR(res.s_com_area_name[0]);
-      res.start_path         := sys.SADR("/sys/File managers/opendial");
-      res.opendir_path       := sys.ADR(res.s_opendir_path[0]);
-      res.dir_default_path   := sys.ADR(res.s_dir_default_path[0]);
-      res.openfile_path      := sys.ADR(res.FilePath[0]);
-      res.filename_area      := sys.ADR(res.FileName[0]);
-
-      replace(res.filter_area.filter, "|", 0X);
-      Dialog_init(res)
-    ELSE
-      DISPOSE(res)
-    END
-  END
-  RETURN res
-END Create;
-
-PROCEDURE Destroy*(VAR od: Dialog);
-BEGIN
-  IF od # NIL THEN
-    DISPOSE(od.filter_area);
-    DISPOSE(od)
-  END
-END Destroy;
-
-PROCEDURE Load;
-VAR Lib: INTEGER;
-
-  PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
-  VAR a: INTEGER;
-  BEGIN
-    a := KOSAPI.GetProcAdr(name, Lib);
-    ASSERT(a # 0);
-    sys.PUT(v, a)
-  END GetProc;
-
-BEGIN
-  Lib := KOSAPI.LoadLib("/sys/Lib/Proc_lib.obj");
-  GetProc(Lib, sys.ADR(Dialog_init),  "OpenDialog_init");
-  GetProc(Lib, sys.ADR(Dialog_start), "OpenDialog_start");
-END Load;
-
-BEGIN
-  Load
-END OpenDlg.

programs/develop/oberon07/lib/KolibriOS/Out.ob07

@@ -1,267 +0,0 @@
-(*
-    Copyright 2016, 2018 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE Out;
-
-IMPORT ConsoleLib, sys := SYSTEM;
-
-CONST
-
-  d = 1.0 - 5.0E-12;
-
-VAR
-
-  Realp: PROCEDURE (x: REAL; width: INTEGER);
-
-PROCEDURE Char*(c: CHAR);
-BEGIN
-  ConsoleLib.write_string(sys.ADR(c), 1)
-END Char;
-
-PROCEDURE String*(s: ARRAY OF CHAR);
-BEGIN
-  ConsoleLib.write_string(sys.ADR(s[0]), LENGTH(s))
-END String;
-
-PROCEDURE WriteInt(x, n: INTEGER);
-VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN;
-BEGIN
-  i := 0;
-  IF n < 1 THEN
-    n := 1
-  END;
-  IF x < 0 THEN
-    x := -x;
-    DEC(n);
-    neg := TRUE
-  END;
-  REPEAT
-    a[i] := CHR(x MOD 10 + ORD("0"));
-    x := x DIV 10;
-    INC(i)
-  UNTIL x = 0;
-  WHILE n > i DO
-    Char(" ");
-    DEC(n)
-  END;
-  IF neg THEN
-    Char("-")
-  END;
-  REPEAT
-    DEC(i);
-    Char(a[i])
-  UNTIL i = 0
-END WriteInt;
-
-PROCEDURE IsNan(AValue: REAL): BOOLEAN;
-VAR h, l: SET;
-BEGIN
-  sys.GET(sys.ADR(AValue), l);
-  sys.GET(sys.ADR(AValue) + 4, h)
-  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
-END IsNan;
-
-PROCEDURE IsInf(x: REAL): BOOLEAN;
-  RETURN ABS(x) = sys.INF()
-END IsInf;
-
-PROCEDURE Int*(x, width: INTEGER);
-VAR i: INTEGER;
-BEGIN
-  IF x # 80000000H THEN
-    WriteInt(x, width)
-  ELSE
-    FOR i := 12 TO width DO
-      Char(20X)
-    END;
-    String("-2147483648")
-  END
-END Int;
-
-PROCEDURE OutInf(x: REAL; width: INTEGER);
-VAR s: ARRAY 5 OF CHAR; i: INTEGER;
-BEGIN
-  IF IsNan(x) THEN
-    s := "Nan";
-    INC(width)
-  ELSIF IsInf(x) & (x > 0.0) THEN
-    s := "+Inf"
-  ELSIF IsInf(x) & (x < 0.0) THEN
-    s := "-Inf"
-  END;
-  FOR i := 1 TO width - 4 DO
-    Char(" ")
-  END;
-  String(s)
-END OutInf;
-
-PROCEDURE Ln*;
-BEGIN
-  Char(0DX);
-  Char(0AX)
-END Ln;
-
-PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
-VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
-BEGIN
-  IF IsNan(x) OR IsInf(x) THEN
-    OutInf(x, width)
-  ELSIF p < 0 THEN
-    Realp(x, width)
-  ELSE
-    len := 0;
-    minus := FALSE;
-    IF x < 0.0 THEN
-      minus := TRUE;
-      INC(len);
-      x := ABS(x)
-    END;
-    e := 0;
-    WHILE x >= 10.0 DO
-      x := x / 10.0;
-      INC(e)
-    END;
-    IF e >= 0 THEN
-      len := len + e + p + 1;
-      IF x > 9.0 + d THEN
-        INC(len)
-      END;
-      IF p > 0 THEN
-        INC(len)
-      END
-    ELSE
-      len := len + p + 2
-    END;
-    FOR i := 1 TO width - len DO
-      Char(" ")
-    END;
-    IF minus THEN
-      Char("-")
-    END;
-    y := x;
-    WHILE (y < 1.0) & (y # 0.0) DO
-      y := y * 10.0;
-      DEC(e)
-    END;
-    IF e < 0 THEN
-      IF x - FLT(FLOOR(x)) > d THEN
-        Char("1");
-        x := 0.0
-      ELSE
-        Char("0");
-        x := x * 10.0
-      END
-    ELSE
-      WHILE e >= 0 DO
-        IF x - FLT(FLOOR(x)) > d THEN
-          IF x > 9.0 THEN
-            String("10")
-          ELSE
-            Char(CHR(FLOOR(x) + ORD("0") + 1))
-          END;
-          x := 0.0
-        ELSE
-          Char(CHR(FLOOR(x) + ORD("0")));
-          x := (x - FLT(FLOOR(x))) * 10.0
-        END;
-        DEC(e)
-      END
-    END;
-    IF p > 0 THEN
-      Char(".")
-    END;
-    WHILE p > 0 DO
-      IF x - FLT(FLOOR(x)) > d THEN
-        Char(CHR(FLOOR(x) + ORD("0") + 1));
-        x := 0.0
-      ELSE
-        Char(CHR(FLOOR(x) + ORD("0")));
-        x := (x - FLT(FLOOR(x))) * 10.0
-      END;
-      DEC(p)
-    END
-  END
-END _FixReal;
-
-PROCEDURE Real*(x: REAL; width: INTEGER);
-VAR e, n, i: INTEGER; minus: BOOLEAN;
-BEGIN
-  IF IsNan(x) OR IsInf(x) THEN
-    OutInf(x, width)
-  ELSE
-    e := 0;
-    n := 0;
-    IF width > 23 THEN
-      n := width - 23;
-      width := 23
-    ELSIF width < 9 THEN
-      width := 9
-    END;
-    width := width - 5;
-    IF x < 0.0 THEN
-      x := -x;
-      minus := TRUE
-    ELSE
-      minus := FALSE
-    END;
-    WHILE x >= 10.0 DO
-      x := x / 10.0;
-      INC(e)
-    END;
-    WHILE (x < 1.0) & (x # 0.0) DO
-      x := x * 10.0;
-      DEC(e)
-    END;
-    IF x > 9.0 + d THEN
-      x := 1.0;
-      INC(e)
-    END;
-    FOR i := 1 TO n DO
-      Char(" ")
-    END;
-    IF minus THEN
-      x := -x
-    END;
-    Realp := Real;
-    _FixReal(x, width, width - 3);
-    Char("E");
-    IF e >= 0 THEN
-      Char("+")
-    ELSE
-      Char("-");
-      e := ABS(e)
-    END;
-    IF e < 100 THEN
-      Char("0")
-    END;
-    IF e < 10 THEN
-      Char("0")
-    END;
-    Int(e, 0)
-  END
-END Real;
-
-PROCEDURE FixReal*(x: REAL; width, p: INTEGER);
-BEGIN
-  Realp := Real;
-  _FixReal(x, width, p)
-END FixReal;
-
-PROCEDURE Open*;
-END Open;
-
-END Out.

programs/develop/oberon07/lib/KolibriOS/RTL.ob07

@@ -1,543 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE RTL;
-
-IMPORT SYSTEM, API;
-
-
-CONST
-
-    minint = ROR(1, 1);
-
-    WORD = API.BIT_DEPTH DIV 8;
-
-
-VAR
-
-    name:  INTEGER;
-    types: INTEGER;
-
-
-PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
-BEGIN
-    SYSTEM.CODE(
-    08BH, 045H, 008H,    (*  mov eax, dword [ebp + 8]   *)
-    085H, 0C0H,          (*  test eax, eax              *)
-    07EH, 019H,          (*  jle L                      *)
-    0FCH,                (*  cld                        *)
-    057H,                (*  push edi                   *)
-    056H,                (*  push esi                   *)
-    08BH, 075H, 010H,    (*  mov esi, dword [ebp + 16]  *)
-    08BH, 07DH, 00CH,    (*  mov edi, dword [ebp + 12]  *)
-    089H, 0C1H,          (*  mov ecx, eax               *)
-    0C1H, 0E9H, 002H,    (*  shr ecx, 2                 *)
-    0F3H, 0A5H,          (*  rep movsd                  *)
-    089H, 0C1H,          (*  mov ecx, eax               *)
-    083H, 0E1H, 003H,    (*  and ecx, 3                 *)
-    0F3H, 0A4H,          (*  rep movsb                  *)
-    05EH,                (*  pop esi                    *)
-    05FH                 (*  pop edi                    *)
-                         (*  L:                         *)
-                )
-END _move;
-
-
-PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
-VAR
-    res: BOOLEAN;
-
-BEGIN
-    IF len_src > len_dst THEN
-        res := FALSE
-    ELSE
-        _move(len_src * base_size, dst, src);
-        res := TRUE
-    END
-
-    RETURN res
-END _arrcpy;
-
-
-PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
-BEGIN
-    _move(MIN(len_dst, len_src) * chr_size, dst, src)
-END _strcpy;
-
-
-PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER);
-BEGIN
-    SYSTEM.CODE(
-    08BH, 04DH, 008H,   (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- Len *)
-    08BH, 045H, 00CH,   (*  mov   eax, dword [ebp + 12]  *)  (* eax <- Ptr *)
-    049H,               (*  dec   ecx                    *)
-    053H,               (*  push  ebx                    *)
-    08BH, 018H,         (*  mov   ebx, dword [eax]       *)
-                        (*  L:                           *)
-    08BH, 050H, 004H,   (*  mov   edx, dword [eax + 4]   *)
-    089H, 010H,         (*  mov   dword [eax], edx       *)
-    083H, 0C0H, 004H,   (*  add   eax, 4                 *)
-    049H,               (*  dec   ecx                    *)
-    075H, 0F5H,         (*  jnz   L                      *)
-    089H, 018H,         (*  mov   dword [eax], ebx       *)
-    05BH,               (*  pop   ebx                    *)
-    05DH,               (*  pop   ebp                    *)
-    0C2H, 008H, 000H    (*  ret   8                      *)
-    )
-END _rot;
-
-
-PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *)
-BEGIN
-    SYSTEM.CODE(
-    08BH, 04DH, 008H,              (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- b *)
-    08BH, 045H, 00CH,              (*  mov   eax, dword [ebp + 12]  *)  (* eax <- a *)
-    039H, 0C8H,                    (*  cmp   eax, ecx               *)
-    07FH, 033H,                    (*  jg    L1                     *)
-    083H, 0F8H, 01FH,              (*  cmp   eax, 31                *)
-    07FH, 02EH,                    (*  jg    L1                     *)
-    085H, 0C9H,                    (*  test  ecx, ecx               *)
-    07CH, 02AH,                    (*  jl    L1                     *)
-    083H, 0F9H, 01FH,              (*  cmp   ecx, 31                *)
-    07EH, 005H,                    (*  jle   L3                     *)
-    0B9H, 01FH, 000H, 000H, 000H,  (*  mov   ecx, 31                *)
-                                   (*  L3:                          *)
-    085H, 0C0H,                    (*  test  eax, eax               *)
-    07DH, 002H,                    (*  jge   L2                     *)
-    031H, 0C0H,                    (*  xor   eax, eax               *)
-                                   (*  L2:                          *)
-    089H, 0CAH,                    (*  mov   edx, ecx               *)
-    029H, 0C2H,                    (*  sub   edx, eax               *)
-    0B8H, 000H, 000H, 000H, 080H,  (*  mov   eax, 0x80000000        *)
-    087H, 0CAH,                    (*  xchg  edx, ecx               *)
-    0D3H, 0F8H,                    (*  sar   eax, cl                *)
-    087H, 0CAH,                    (*  xchg  edx, ecx               *)
-    083H, 0E9H, 01FH,              (*  sub   ecx, 31                *)
-    0F7H, 0D9H,                    (*  neg   ecx                    *)
-    0D3H, 0E8H,                    (*  shr   eax, cl                *)
-    05DH,                          (*  pop   ebp                    *)
-    0C2H, 008H, 000H,              (*  ret   8                      *)
-                                   (*  L1:                          *)
-    031H, 0C0H,                    (*  xor   eax, eax               *)
-    05DH,                          (*  pop   ebp                    *)
-    0C2H, 008H, 000H               (*  ret   8                      *)
-    )
-END _set;
-
-
-PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
-BEGIN
-    SYSTEM.CODE(
-    031H, 0C0H,         (*  xor  eax, eax              *)
-    08BH, 04DH, 008H,   (*  mov  ecx, dword [ebp + 8]  *)  (* ecx <- a *)
-    083H, 0F9H, 01FH,   (*  cmp  ecx, 31               *)
-    077H, 003H,         (*  ja   L                     *)
-    00FH, 0ABH, 0C8H    (*  bts  eax, ecx              *)
-                        (*  L:                         *)
-    )
-END _set1;
-
-
-PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
-BEGIN
-    SYSTEM.CODE(
-    053H,                (*  push    ebx                    *)
-    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 12]  *)  (* eax <- x *)
-    031H, 0D2H,          (*  xor     edx, edx               *)
-    085H, 0C0H,          (*  test    eax, eax               *)
-    074H, 018H,          (*  je      L2                     *)
-    07FH, 002H,          (*  jg      L1                     *)
-    0F7H, 0D2H,          (*  not     edx                    *)
-                         (*  L1:                            *)
-    089H, 0C3H,          (*  mov     ebx, eax               *)
-    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 8]   *)  (* ecx <- y *)
-    0F7H, 0F9H,          (*  idiv    ecx                    *)
-    085H, 0D2H,          (*  test    edx, edx               *)
-    074H, 009H,          (*  je      L2                     *)
-    031H, 0CBH,          (*  xor     ebx, ecx               *)
-    085H, 0DBH,          (*  test    ebx, ebx               *)
-    07DH, 003H,          (*  jge     L2                     *)
-    048H,                (*  dec     eax                    *)
-    001H, 0CAH,          (*  add     edx, ecx               *)
-                         (*  L2:                            *)
-    05BH                 (*  pop     ebx                    *)
-               )
-END _divmod;
-
-
-PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
-BEGIN
-    ptr := API._NEW(size);
-    IF ptr # 0 THEN
-        SYSTEM.PUT(ptr, t);
-        INC(ptr, WORD)
-    END
-END _new;
-
-
-PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
-BEGIN
-    IF ptr # 0 THEN
-        ptr := API._DISPOSE(ptr - WORD)
-    END
-END _dispose;
-
-
-PROCEDURE [stdcall] _length* (len, str: INTEGER);
-BEGIN
-    SYSTEM.CODE(
-    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 0Ch]  *)
-    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 08h]  *)
-    048H,                (*  dec     eax                     *)
-                         (*  L1:                             *)
-    040H,                (*  inc     eax                     *)
-    080H, 038H, 000H,    (*  cmp     byte [eax], 0           *)
-    074H, 003H,          (*  jz      L2                      *)
-    0E2H, 0F8H,          (*  loop    L1                      *)
-    040H,                (*  inc     eax                     *)
-                         (*  L2:                             *)
-    02BH, 045H, 00CH     (*  sub     eax, dword [ebp + 0Ch]  *)
-               )
-END _length;
-
-
-PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
-BEGIN
-    SYSTEM.CODE(
-    08BH, 045H, 00CH,         (*  mov     eax, dword [ebp + 0Ch]  *)
-    08BH, 04DH, 008H,         (*  mov     ecx, dword [ebp + 08h]  *)
-    048H,                     (*  dec     eax                     *)
-    048H,                     (*  dec     eax                     *)
-                              (*  L1:                             *)
-    040H,                     (*  inc     eax                     *)
-    040H,                     (*  inc     eax                     *)
-    066H, 083H, 038H, 000H,   (*  cmp     word [eax], 0           *)
-    074H, 004H,               (*  jz      L2                      *)
-    0E2H, 0F6H,               (*  loop    L1                      *)
-    040H,                     (*  inc     eax                     *)
-    040H,                     (*  inc     eax                     *)
-                              (*  L2:                             *)
-    02BH, 045H, 00CH,         (*  sub     eax, dword [ebp + 0Ch]  *)
-    0D1H, 0E8H                (*  shr     eax, 1                  *)
-               )
-END _lengthw;
-
-
-PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(
-    056H,                    (*  push    esi                            *)
-    057H,                    (*  push    edi                            *)
-    053H,                    (*  push    ebx                            *)
-    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
-    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
-    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
-    031H, 0C9H,              (*  xor     ecx, ecx                       *)
-    031H, 0D2H,              (*  xor     edx, edx                       *)
-    0B8H,
-    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
-                             (*  L1:                                    *)
-    085H, 0DBH,              (*  test    ebx, ebx                       *)
-    07EH, 017H,              (*  jle     L3                             *)
-    08AH, 00EH,              (*  mov     cl, byte[esi]                  *)
-    08AH, 017H,              (*  mov     dl, byte[edi]                  *)
-    046H,                    (*  inc     esi                            *)
-    047H,                    (*  inc     edi                            *)
-    04BH,                    (*  dec     ebx                            *)
-    039H, 0D1H,              (*  cmp     ecx, edx                       *)
-    074H, 006H,              (*  je      L2                             *)
-    089H, 0C8H,              (*  mov     eax, ecx                       *)
-    029H, 0D0H,              (*  sub     eax, edx                       *)
-    0EBH, 006H,              (*  jmp     L3                             *)
-                             (*  L2:                                    *)
-    085H, 0C9H,              (*  test    ecx, ecx                       *)
-    075H, 0E7H,              (*  jne     L1                             *)
-    031H, 0C0H,              (*  xor     eax, eax                       *)
-                             (*  L3:                                    *)
-    05BH,                    (*  pop     ebx                            *)
-    05FH,                    (*  pop     edi                            *)
-    05EH,                    (*  pop     esi                            *)
-    05DH,                    (*  pop     ebp                            *)
-    0C2H, 00CH, 000H         (*  ret     12                             *)
-    )
-    RETURN 0
-END strncmp;
-
-
-PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.CODE(
-    056H,                    (*  push    esi                            *)
-    057H,                    (*  push    edi                            *)
-    053H,                    (*  push    ebx                            *)
-    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
-    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
-    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
-    031H, 0C9H,              (*  xor     ecx, ecx                       *)
-    031H, 0D2H,              (*  xor     edx, edx                       *)
-    0B8H,
-    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
-                             (*  L1:                                    *)
-    085H, 0DBH,              (*  test    ebx, ebx                       *)
-    07EH, 01BH,              (*  jle     L3                             *)
-    066H, 08BH, 00EH,        (*  mov     cx, word[esi]                  *)
-    066H, 08BH, 017H,        (*  mov     dx, word[edi]                  *)
-    046H,                    (*  inc     esi                            *)
-    046H,                    (*  inc     esi                            *)
-    047H,                    (*  inc     edi                            *)
-    047H,                    (*  inc     edi                            *)
-    04BH,                    (*  dec     ebx                            *)
-    039H, 0D1H,              (*  cmp     ecx, edx                       *)
-    074H, 006H,              (*  je      L2                             *)
-    089H, 0C8H,              (*  mov     eax, ecx                       *)
-    029H, 0D0H,              (*  sub     eax, edx                       *)
-    0EBH, 006H,              (*  jmp     L3                             *)
-                             (*  L2:                                    *)
-    085H, 0C9H,              (*  test    ecx, ecx                       *)
-    075H, 0E3H,              (*  jne     L1                             *)
-    031H, 0C0H,              (*  xor     eax, eax                       *)
-                             (*  L3:                                    *)
-    05BH,                    (*  pop     ebx                            *)
-    05FH,                    (*  pop     edi                            *)
-    05EH,                    (*  pop     esi                            *)
-    05DH,                    (*  pop     ebp                            *)
-    0C2H, 00CH, 000H         (*  ret     12                             *)
-    )
-    RETURN 0
-END strncmpw;
-
-
-PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
-VAR
-    res:  INTEGER;
-    bRes: BOOLEAN;
-    c:    CHAR;
-
-BEGIN
-    res := strncmp(str1, str2, MIN(len1, len2));
-    IF res = minint THEN
-        IF len1 > len2 THEN
-            SYSTEM.GET(str1 + len2, c);
-            res := ORD(c)
-        ELSIF len1 < len2 THEN
-            SYSTEM.GET(str2 + len1, c);
-            res := -ORD(c)
-        ELSE
-            res := 0
-        END
-    END;
-
-    CASE op OF
-    |0: bRes := res =  0
-    |1: bRes := res #  0
-    |2: bRes := res <  0
-    |3: bRes := res <= 0
-    |4: bRes := res >  0
-    |5: bRes := res >= 0
-    END
-
-    RETURN bRes
-END _strcmp;
-
-
-PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
-VAR
-    res:  INTEGER;
-    bRes: BOOLEAN;
-    c:    WCHAR;
-
-BEGIN
-    res := strncmpw(str1, str2, MIN(len1, len2));
-    IF res = minint THEN
-        IF len1 > len2 THEN
-            SYSTEM.GET(str1 + len2 * 2, c);
-            res := ORD(c)
-        ELSIF len1 < len2 THEN
-            SYSTEM.GET(str2 + len1 * 2, c);
-            res := -ORD(c)
-        ELSE
-            res := 0
-        END
-    END;
-
-    CASE op OF
-    |0: bRes := res =  0
-    |1: bRes := res #  0
-    |2: bRes := res <  0
-    |3: bRes := res <= 0
-    |4: bRes := res >  0
-    |5: bRes := res >= 0
-    END
-
-    RETURN bRes
-END _strcmpw;
-
-
-PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
-    c: CHAR;
-    i: INTEGER;
-
-BEGIN
-    i := 0;
-    REPEAT
-        SYSTEM.GET(pchar, c);
-        s[i] := c;
-        INC(pchar);
-        INC(i)
-    UNTIL c = 0X
-END PCharToStr;
-
-
-PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
-VAR
-    i, a: INTEGER;
-
-BEGIN
-    i := 0;
-    a := x;
-    REPEAT
-        INC(i);
-        a := a DIV 10
-    UNTIL a = 0;
-
-    str[i] := 0X;
-
-    REPEAT
-        DEC(i);
-        str[i] := CHR(x MOD 10 + ORD("0"));
-        x := x DIV 10
-    UNTIL x = 0
-END IntToStr;
-
-
-PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
-VAR
-    n1, n2: INTEGER;
-
-BEGIN
-    n1 := LENGTH(s1);
-    n2 := LENGTH(s2);
-
-    ASSERT(n1 + n2 < LEN(s1));
-
-    SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
-    s1[n1 + n2] := 0X
-END append;
-
-
-PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
-VAR
-    s, temp: ARRAY 1024 OF CHAR;
-
-BEGIN
-    CASE err OF
-    | 1: s := "assertion failure"
-    | 2: s := "NIL dereference"
-    | 3: s := "bad divisor"
-    | 4: s := "NIL procedure call"
-    | 5: s := "type guard error"
-    | 6: s := "index out of range"
-    | 7: s := "invalid CASE"
-    | 8: s := "array assignment error"
-    | 9: s := "CHR out of range"
-    |10: s := "WCHR out of range"
-    |11: s := "BYTE out of range"
-    END;
-
-    append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
-    append(s, API.eol + "line: ");   IntToStr(line, temp);     append(s, temp);
-
-    API.DebugMsg(SYSTEM.ADR(s[0]), name);
-
-    API.exit_thread(0)
-END _error;
-
-
-PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.GET(t0 + t1 + types, t0)
-    RETURN t0 MOD 2
-END _isrec;
-
-
-PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
-BEGIN
-    IF p # 0 THEN
-        SYSTEM.GET(p - WORD, p);
-        SYSTEM.GET(t0 + p + types, p)
-    END
-
-    RETURN p MOD 2
-END _is;
-
-
-PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.GET(t0 + t1 + types, t0)
-    RETURN t0 MOD 2
-END _guardrec;
-
-
-PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
-BEGIN
-    SYSTEM.GET(p, p);
-    IF p # 0 THEN
-        SYSTEM.GET(p - WORD, p);
-        SYSTEM.GET(t0 + p + types, p)
-    ELSE
-        p := 1
-    END
-
-    RETURN p MOD 2
-END _guard;
-
-
-PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
-    RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
-END _dllentry;
-
-
-PROCEDURE [stdcall] _sofinit*;
-BEGIN
-    API.sofinit
-END _sofinit;
-
-
-PROCEDURE [stdcall] _exit* (code: INTEGER);
-BEGIN
-    API.exit(code)
-END _exit;
-
-
-PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
-VAR
-    t0, t1, i, j: INTEGER;
-
-BEGIN
-    SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
-    API.init(param, code);
-
-    types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
-    ASSERT(types # 0);
-    FOR i := 0 TO tcount - 1 DO
-        FOR j := 0 TO tcount - 1 DO
-            t0 := i; t1 := j;
-
-            WHILE (t1 # 0) & (t1 # t0) DO
-                SYSTEM.GET(_types + t1 * WORD, t1)
-            END;
-
-            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
-        END
-    END;
-
-    name := modname
-END _init;
-
-
-END RTL.

programs/develop/oberon07/lib/KolibriOS/RasterWorks.ob07

@@ -1,124 +0,0 @@
-(*
-    Copyright 2016, 2018, 2022 KolibriOS team
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE RasterWorks;
-
-IMPORT sys := SYSTEM, KOSAPI;
-
-
-CONST
-
-(* flags *)
-
-  bold            *=   1;
-  italic          *=   2;
-  underline       *=   4;
-  strike_through  *=   8;
-  align_right     *=  16;
-  align_center    *=  32;
-
-  bpp32           *= 128;
-
-
-(* encoding *)
-
-  cp866           *=   1;
-  utf16le         *=   2;
-  utf8            *=   3;
-
-
-VAR
-
-  // draw text on 24bpp or 32bpp image
-  // autofits text between 'x' and 'xSize'
-  drawText *: PROCEDURE (canvas, x, y, string, charQuantity, fontColor, params: INTEGER): INTEGER;
-(*
-  [canvas]:
-    xSize        dd  ?
-    ySize        dd  ?
-    picture      rb  xSize * ySize * bpp
-
-   fontColor     dd  AARRGGBB
-    AA = alpha channel   ; 0 = transparent, FF = non transparent
-
-   params        dd  ffeewwhh
-    hh = char height
-    ww = char width      ; 0 = auto (proportional)
-    ee = encoding        ; 1 = cp866, 2 = UTF-16LE, 3 = UTF-8
-    ff = flags           ; 0001 = bold, 0010 = italic
-                         ; 0100 = underline, 1000 = strike-through
-   00010000 = align right, 00100000 = align center
-   01000000 = set text area between higher and lower halfs of 'x'
-   10000000 = 32bpp canvas insted of 24bpp
-   all flags combinable, except align right + align center
-
-   returns: char width (0 = error)
-*)
-
-  // calculate amount of valid chars in UTF-8 string
-  // supports zero terminated string (set byteQuantity = -1)
-  countUTF8Z *: PROCEDURE (string, byteQuantity: INTEGER): INTEGER;
-
-
-  // calculate amount of chars that fits given width
-  charsFit *: PROCEDURE (areaWidth, charHeight: INTEGER): INTEGER;
-
-
-  // calculate string width in pixels
-  strWidth *: PROCEDURE (charQuantity, charHeight: INTEGER): INTEGER;
-
-
-PROCEDURE params* (charHeight, charWidth, encoding, flags: INTEGER): INTEGER;
-(*
-    hh = char height
-    ww = char width      ; 0 = auto (proportional)
-    ee = encoding        ; 1 = cp866, 2 = UTF-16LE, 3 = UTF-8
-    ff = flags           ; 0001 = bold, 0010 = italic
-                        ; 0100 = underline, 1000 = strike-through
-   00010000 = align right, 00100000 = align center
-   01000000 = set text area between higher and lower halfs of 'x'
-   10000000 = 32bpp canvas insted of 24bpp
-   all flags combinable, except align right + align center
-*)
-  RETURN charHeight + LSL(charWidth, 8) + LSL(encoding, 16) + LSL(flags, 24)
-END params;
-
-
-PROCEDURE main;
-VAR Lib: INTEGER;
-
-  PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
-  VAR a: INTEGER;
-  BEGIN
-    a := KOSAPI.GetProcAdr(name, Lib);
-    ASSERT(a # 0);
-    sys.PUT(v, a)
-  END GetProc;
-
-BEGIN
-  Lib := KOSAPI.LoadLib("/sys/lib/RasterWorks.obj");
-  ASSERT(Lib # 0);
-  GetProc(Lib, sys.ADR(drawText),   "drawText");
-  GetProc(Lib, sys.ADR(countUTF8Z), "countUTF8Z");
-  GetProc(Lib, sys.ADR(charsFit),   "charsFit");
-  GetProc(Lib, sys.ADR(strWidth),   "strWidth");
-END main;
-
-
-BEGIN
-  main
-END RasterWorks.

programs/develop/oberon07/lib/KolibriOS/Read.ob07

@@ -1,46 +0,0 @@
-(*
-    Copyright 2016, 2018 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE Read;
-
-IMPORT File, sys := SYSTEM;
-
-PROCEDURE Char*(F: File.FS; VAR x: CHAR): BOOLEAN;
-  RETURN File.Read(F, sys.ADR(x), sys.SIZE(CHAR)) = sys.SIZE(CHAR)
-END Char;
-
-PROCEDURE Int*(F: File.FS; VAR x: INTEGER): BOOLEAN;
-  RETURN File.Read(F, sys.ADR(x), sys.SIZE(INTEGER)) = sys.SIZE(INTEGER)
-END Int;
-
-PROCEDURE Real*(F: File.FS; VAR x: REAL): BOOLEAN;
-  RETURN File.Read(F, sys.ADR(x), sys.SIZE(REAL)) = sys.SIZE(REAL)
-END Real;
-
-PROCEDURE Boolean*(F: File.FS; VAR x: BOOLEAN): BOOLEAN;
-  RETURN File.Read(F, sys.ADR(x), sys.SIZE(BOOLEAN)) = sys.SIZE(BOOLEAN)
-END Boolean;
-
-PROCEDURE Set*(F: File.FS; VAR x: SET): BOOLEAN;
-  RETURN File.Read(F, sys.ADR(x), sys.SIZE(SET)) = sys.SIZE(SET)
-END Set;
-
-PROCEDURE WChar*(F: File.FS; VAR x: WCHAR): BOOLEAN;
-  RETURN File.Read(F, sys.ADR(x), sys.SIZE(WCHAR)) = sys.SIZE(WCHAR)
-END WChar;
-
-END Read.

programs/develop/oberon07/lib/KolibriOS/UnixTime.ob07

@@ -1,64 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2019, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE UnixTime;
-
-
-VAR
-
-    days: ARRAY 12, 31, 2 OF INTEGER;
-
-
-PROCEDURE init;
-VAR
-    i, j, k, n0, n1: INTEGER;
-BEGIN
-
-    FOR i := 0 TO 11 DO
-        FOR j := 0 TO 30 DO
-            days[i, j, 0] := 0;
-            days[i, j, 1] := 0;
-        END
-    END;
-
-    days[ 1, 28, 0] := -1;
-
-    FOR k := 0 TO 1 DO
-        days[ 1, 29, k] := -1;
-        days[ 1, 30, k] := -1;
-        days[ 3, 30, k] := -1;
-        days[ 5, 30, k] := -1;
-        days[ 8, 30, k] := -1;
-        days[10, 30, k] := -1;
-    END;
-
-    n0 := 0;
-    n1 := 0;
-    FOR i := 0 TO 11 DO
-        FOR j := 0 TO 30 DO
-            IF days[i, j, 0] = 0 THEN
-                days[i, j, 0] := n0;
-                INC(n0)
-            END;
-            IF days[i, j, 1] = 0 THEN
-                days[i, j, 1] := n1;
-                INC(n1)
-            END
-        END
-    END
-
-END init;
-
-
-PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER;
-    RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec
-END time;
-
-
-BEGIN
-    init
-END UnixTime.

programs/develop/oberon07/lib/KolibriOS/Vector.ob07

@@ -1,121 +0,0 @@
-(*
-    Copyright 2016 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE Vector;
-
-
-IMPORT sys := SYSTEM, K := KOSAPI;
-
-
-TYPE
-
-  DESC_VECTOR = RECORD
-
-    data   : INTEGER;
-    count  : INTEGER;
-    size   : INTEGER
-
-  END;
-
-  VECTOR* = POINTER TO DESC_VECTOR;
-
-  ANYREC* = RECORD END;
-
-  ANYPTR* = POINTER TO ANYREC;
-
-  DESTRUCTOR* = PROCEDURE (VAR ptr: ANYPTR);
-
-
-PROCEDURE count* (vector: VECTOR): INTEGER;
-BEGIN
-  ASSERT(vector # NIL)
-  RETURN vector.count
-END count;
-
-
-PROCEDURE push* (vector: VECTOR; value: ANYPTR);
-BEGIN
-  ASSERT(vector # NIL);
-  IF vector.count = vector.size THEN
-    vector.data := K.realloc(vector.data, (vector.size + 1024) * 4);
-    ASSERT(vector.data # 0);
-    vector.size := vector.size + 1024
-  END;
-  sys.PUT(vector.data + vector.count * 4, value);
-  INC(vector.count)
-END push;
-
-
-PROCEDURE get* (vector: VECTOR; idx: INTEGER): ANYPTR;
-VAR res: ANYPTR;
-BEGIN
-  ASSERT(vector # NIL);
-  ASSERT( (0 <= idx) & (idx < vector.count) );
-  sys.GET(vector.data + idx * 4, res)
-  RETURN res
-END get;
-
-
-PROCEDURE put* (vector: VECTOR; idx: INTEGER; value: ANYPTR);
-BEGIN
-  ASSERT(vector # NIL);
-  ASSERT( (0 <= idx) & (idx < vector.count) );
-  sys.PUT(vector.data + idx * 4, value)
-END put;
-
-
-PROCEDURE create* (size: INTEGER): VECTOR;
-VAR vector: VECTOR;
-BEGIN
-  NEW(vector);
-  IF vector # NIL THEN
-    vector.data  := K.malloc(4 * size);
-    IF vector.data # 0 THEN
-      vector.size  := size;
-      vector.count := 0
-    ELSE
-      DISPOSE(vector)
-    END
-  END
-  RETURN vector
-END create;
-
-
-PROCEDURE def_destructor (VAR any: ANYPTR);
-BEGIN
-  DISPOSE(any)
-END def_destructor;
-
-
-PROCEDURE destroy* (VAR vector: VECTOR; destructor: DESTRUCTOR);
-VAR i: INTEGER;
-    any: ANYPTR;
-BEGIN
-  ASSERT(vector # NIL);
-  IF destructor = NIL THEN
-    destructor := def_destructor
-  END;
-  FOR i := 0 TO vector.count - 1 DO
-    any := get(vector, i);
-    destructor(any)
-  END;
-  vector.data := K.free(vector.data);
-  DISPOSE(vector)
-END destroy;
-
-
-END Vector.

programs/develop/oberon07/lib/KolibriOS/Write.ob07

@@ -1,46 +0,0 @@
-(*
-    Copyright 2016, 2018 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE Write;
-
-IMPORT File, sys := SYSTEM;
-
-PROCEDURE Char*(F: File.FS; x: CHAR): BOOLEAN;
-  RETURN File.Write(F, sys.ADR(x), sys.SIZE(CHAR)) = sys.SIZE(CHAR)
-END Char;
-
-PROCEDURE Int*(F: File.FS; x: INTEGER): BOOLEAN;
-  RETURN File.Write(F, sys.ADR(x), sys.SIZE(INTEGER)) = sys.SIZE(INTEGER)
-END Int;
-
-PROCEDURE Real*(F: File.FS; x: REAL): BOOLEAN;
-  RETURN File.Write(F, sys.ADR(x), sys.SIZE(REAL)) = sys.SIZE(REAL)
-END Real;
-
-PROCEDURE Boolean*(F: File.FS; x: BOOLEAN): BOOLEAN;
-  RETURN File.Write(F, sys.ADR(x), sys.SIZE(BOOLEAN)) = sys.SIZE(BOOLEAN)
-END Boolean;
-
-PROCEDURE Set*(F: File.FS; x: SET): BOOLEAN;
-  RETURN File.Write(F, sys.ADR(x), sys.SIZE(SET)) = sys.SIZE(SET)
-END Set;
-
-PROCEDURE WChar*(F: File.FS; x: WCHAR): BOOLEAN;
-  RETURN File.Write(F, sys.ADR(x), sys.SIZE(WCHAR)) = sys.SIZE(WCHAR)
-END WChar;
-
-END Write.

programs/develop/oberon07/lib/KolibriOS/kfonts.ob07

@@ -1,492 +0,0 @@
-(*
-    Copyright 2016, 2018 Anton Krotov
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE kfonts;
-
-IMPORT sys := SYSTEM, File, KOSAPI;
-
-CONST
-
-  MIN_FONT_SIZE = 8;
-  MAX_FONT_SIZE = 46;
-
-  bold            *=   1;
-  italic          *=   2;
-  underline       *=   4;
-  strike_through  *=   8;
-  smoothing       *=  16;
-  bpp32           *=  32;
-
-TYPE
-
-  Glyph = RECORD
-    base: INTEGER;
-    xsize, ysize: INTEGER;
-    width: INTEGER
-  END;
-
-  TFont_desc = RECORD
-
-    data, size, font, char_size, width, height, font_size, mem, mempos: INTEGER;
-    glyphs: ARRAY 4, 256 OF Glyph
-
-  END;
-
-  TFont* = POINTER TO TFont_desc;
-
-
-PROCEDURE [stdcall] zeromem(size, adr: INTEGER);
-BEGIN
-  sys.CODE(057H, 08BH, 07DH, 00CH, 08BH, 04DH, 008H, 033H, 0C0H, 09CH, 0FCH, 0F3H, 0ABH, 09DH, 05FH)
-END zeromem;
-
-PROCEDURE pset(buf, x, y, color: INTEGER; bpp32: BOOLEAN);
-VAR xsize, ysize: INTEGER;
-BEGIN
-  sys.GET(buf, xsize);
-  sys.GET(buf + 4, ysize);
-  INC(buf, 8);
-  IF (0 <= x) & (x < xsize) & (0 <= y) & (y < ysize) THEN
-    IF bpp32 THEN
-      sys.PUT(buf + 4 * (xsize * y + x), color)
-    ELSE
-      sys.MOVE(sys.ADR(color), buf + 3 * (xsize * y + x), 3)
-    END
-  END
-END pset;
-
-PROCEDURE pget(buf, x, y: INTEGER; bpp32: BOOLEAN): INTEGER;
-VAR xsize, ysize, color: INTEGER;
-BEGIN
-  sys.GET(buf, xsize);
-  sys.GET(buf + 4, ysize);
-  INC(buf, 8);
-  IF (0 <= x) & (x < xsize) & (0 <= y) & (y < ysize) THEN
-    IF bpp32 THEN
-      sys.GET(buf + 4 * (xsize * y + x), color)
-    ELSE
-      sys.MOVE(buf + 3 * (xsize * y + x), sys.ADR(color), 3)
-    END
-  END
-  RETURN color
-END pget;
-
-PROCEDURE getrgb(color: INTEGER; VAR r, g, b: INTEGER);
-BEGIN
-  b := LSR(LSL(color, 24), 24);
-  g := LSR(LSL(color, 16), 24);
-  r := LSR(LSL(color,  8), 24);
-END getrgb;
-
-PROCEDURE rgb(r, g, b: INTEGER): INTEGER;
-  RETURN b + LSL(g, 8) + LSL(r, 16)
-END rgb;
-
-PROCEDURE create_glyph(VAR Font: TFont_desc; VAR glyph: Glyph; xsize, ysize: INTEGER);
-BEGIN
-  glyph.base := Font.mempos;
-  glyph.xsize := xsize;
-  glyph.ysize := ysize;
-  Font.mempos := Font.mempos + xsize * ysize
-END create_glyph;
-
-PROCEDURE getpix(Font: TFont_desc; n, x, y, xsize: INTEGER): CHAR;
-VAR res: CHAR;
-BEGIN
-  sys.GET(Font.mem + n + x + y * xsize, res)
-  RETURN res
-END getpix;
-
-PROCEDURE setpix(VAR Font: TFont_desc; n, x, y, xsize: INTEGER; c: CHAR);
-BEGIN
-  sys.PUT(Font.mem + n + x + y * xsize, c)
-END setpix;
-
-PROCEDURE smooth(VAR Font: TFont_desc; n, xsize, ysize: INTEGER);
-VAR x, y: INTEGER;
-BEGIN
-  FOR y := 1 TO ysize - 1 DO
-    FOR x := 1 TO xsize - 1 DO
-      IF (getpix(Font, n, x, y, xsize) = 1X) & (getpix(Font, n, x - 1, y - 1, xsize) = 1X) &
-         (getpix(Font, n, x - 1, y, xsize) = 0X) & (getpix(Font, n, x, y - 1, xsize) = 0X) THEN
-        setpix(Font, n, x - 1, y, xsize, 2X);
-        setpix(Font, n, x, y - 1, xsize, 2X)
-      END;
-      IF (getpix(Font, n, x, y, xsize) = 0X) & (getpix(Font, n, x - 1, y - 1, xsize) = 0X) &
-         (getpix(Font, n, x - 1, y, xsize) = 1X) & (getpix(Font, n, x, y - 1, xsize) = 1X) THEN
-        setpix(Font, n, x, y, xsize, 2X);
-        setpix(Font, n, x - 1, y - 1, xsize, 2X)
-      END
-    END
-  END
-END smooth;
-
-PROCEDURE _bold(VAR Font: TFont_desc; src, dst, src_xsize, dst_xsize, n: INTEGER);
-VAR i, j, k: INTEGER; pix: CHAR;
-BEGIN
-  FOR i := 0 TO src_xsize - 1 DO
-    FOR j := 0 TO Font.height - 1 DO
-      pix := getpix(Font, src, i, j, src_xsize);
-      IF pix = 1X THEN
-        FOR k := 0 TO n DO
-          setpix(Font, dst, i + k, j, dst_xsize, pix)
-        END
-      END
-    END
-  END
-END _bold;
-
-PROCEDURE make_glyph(VAR Font: TFont_desc; c: INTEGER);
-VAR ptr, i, j, max, x, y: INTEGER; s: SET; eoc: BOOLEAN;
-    glyph: Glyph; pix: CHAR; bold_width: INTEGER;
-BEGIN
-  create_glyph(Font, glyph, Font.width, Font.height);
-  x := 0;
-  y := 0;
-  max := 0;
-  ptr := Font.font + Font.char_size * c;
-  eoc := FALSE;
-  REPEAT
-    sys.GET(ptr, s);
-    INC(ptr, 4);
-    FOR i := 0 TO 31 DO
-      IF ~eoc THEN
-        IF i IN s THEN
-          setpix(Font, glyph.base, x, y, Font.width, 1X);
-          IF x > max THEN
-            max := x
-          END
-        ELSE
-          setpix(Font, glyph.base, x, y, Font.width, 0X)
-        END
-      END;
-      INC(x);
-      IF x = Font.width THEN
-        x := 0;
-        INC(y);
-        eoc := eoc OR (y = Font.height)
-      END
-    END
-  UNTIL eoc;
-  IF max = 0 THEN
-    max := Font.width DIV 3
-  END;
-
-  glyph.width := max;
-  smooth(Font, glyph.base, glyph.xsize, glyph.ysize);
-  Font.glyphs[0, c] := glyph;
-
-  bold_width := 1;
-
-  create_glyph(Font, glyph, Font.width + bold_width, Font.height);
-  _bold(Font, Font.glyphs[0, c].base, glyph.base, Font.glyphs[0, c].xsize, glyph.xsize, bold_width);
-  smooth(Font, glyph.base, glyph.xsize, glyph.ysize);
-  glyph.width := max + bold_width;
-  Font.glyphs[1, c] := glyph;
-
-  create_glyph(Font, glyph, Font.width + (Font.height - 1) DIV 3, Font.height);
-  FOR i := 0 TO Font.glyphs[0, c].xsize - 1 DO
-    FOR j := 0 TO Font.height - 1 DO
-      pix := getpix(Font, Font.glyphs[0, c].base, i, j, Font.glyphs[0, c].xsize);
-      IF pix = 1X THEN
-        setpix(Font, glyph.base, i + (Font.height - 1 - j) DIV 3, j, glyph.xsize, pix)
-      END
-    END
-  END;
-  smooth(Font, glyph.base, glyph.xsize, glyph.ysize);
-  glyph.width := max;
-  Font.glyphs[2, c] := glyph;
-
-  create_glyph(Font, glyph, Font.width + (Font.height - 1) DIV 3 + bold_width, Font.height);
-  _bold(Font, Font.glyphs[2, c].base, glyph.base, Font.glyphs[2, c].xsize, glyph.xsize, bold_width);
-  smooth(Font, glyph.base, glyph.xsize, glyph.ysize);
-  glyph.width := max + bold_width;
-  Font.glyphs[3, c] := glyph;
-
-END make_glyph;
-
-PROCEDURE OutChar(Font: TFont_desc; c: INTEGER; x, y: INTEGER; buf: INTEGER; bpp32, smoothing: BOOLEAN; color, style: INTEGER): INTEGER;
-VAR i, x0, y0, xsize, mem, xmax: INTEGER; r, g, b, r0, g0, b0: INTEGER; ch: CHAR; glyph: Glyph;
-BEGIN
-  x0 := x;
-  y0 := y;
-  style := style MOD 4;
-  glyph := Font.glyphs[style, c];
-  xsize := glyph.xsize;
-  xmax := x0 + xsize;
-  mem := Font.mem + glyph.base;
-  getrgb(color, r0, g0, b0);
-  FOR i := mem TO mem + xsize * Font.height - 1 DO
-    sys.GET(i, ch);
-    IF ch = 1X THEN
-      pset(buf, x, y, color, bpp32);
-    ELSIF (ch = 2X) & smoothing THEN
-      getrgb(pget(buf, x, y, bpp32), r, g, b);
-      r := (r * 3 + r0) DIV 4;
-      g := (g * 3 + g0) DIV 4;
-      b := (b * 3 + b0) DIV 4;
-      pset(buf, x, y, rgb(r, g, b), bpp32)
-    END;
-    INC(x);
-    IF x = xmax THEN
-      x := x0;
-      INC(y)
-    END
-  END
-  RETURN glyph.width
-END OutChar;
-
-PROCEDURE hline(buf, x, y, width, color: INTEGER; bpp32: BOOLEAN);
-VAR i: INTEGER;
-BEGIN
-  FOR i := x TO x + width - 1 DO
-    pset(buf, i, y, color, bpp32)
-  END
-END hline;
-
-PROCEDURE TextWidth*(Font: TFont; str, length, params: INTEGER): INTEGER;
-VAR res: INTEGER; c: CHAR;
-BEGIN
-  res := 0;
-  params := params MOD 4;
-  IF Font # NIL THEN
-    sys.GET(str, c);
-    WHILE (length > 0) OR (length = -1) & (c # 0X) DO
-      INC(str);
-      res := res + Font.glyphs[params, ORD(c)].width;
-      IF length > 0 THEN
-        DEC(length)
-      END;
-      IF length # 0 THEN
-        sys.GET(str, c)
-      END
-    END
-  END
-  RETURN res
-END TextWidth;
-
-PROCEDURE TextHeight*(Font: TFont): INTEGER;
-VAR res: INTEGER;
-BEGIN
-  IF Font # NIL THEN
-    res := Font.height
-  ELSE
-    res := 0
-  END
-  RETURN res
-END TextHeight;
-
-PROCEDURE TextClipLeft(Font: TFont; str, length, params: INTEGER; VAR x: INTEGER): INTEGER;
-VAR x1: INTEGER; c: CHAR;
-BEGIN
-  params := params MOD 4;
-  sys.GET(str, c);
-  WHILE (length > 0) OR (length = -1) & (c # 0X) DO
-    INC(str);
-    x1 := x;
-    x := x + Font.glyphs[params, ORD(c)].width;
-    IF x > 0 THEN
-      length := 0;
-    END;
-    IF length > 0 THEN
-      DEC(length)
-    END;
-    IF length # 0 THEN
-      sys.GET(str, c)
-    END
-  END;
-  x := x1
-  RETURN str - 1
-END TextClipLeft;
-
-PROCEDURE TextOut*(Font: TFont; canvas, x, y, str, length, color, params: INTEGER);
-VAR width, xsize, ysize, str1, n: INTEGER; c: CHAR; bpp32, smoothing, underline, strike: BOOLEAN;
-BEGIN
-  IF Font # NIL THEN
-    sys.GET(canvas,     xsize);
-    sys.GET(canvas + 4, ysize);
-    IF (y <= -TextHeight(Font)) OR (y >= ysize) THEN
-      length := 0
-    END;
-    IF length # 0 THEN
-      smoothing := 4 IN BITS(params);
-      bpp32 := 5 IN BITS(params);
-      underline := 2 IN BITS(params);
-      strike := 3 IN BITS(params);
-      str1 := TextClipLeft(Font, str, length, params, x);
-      n := str1 - str;
-      str := str1;
-      IF length >= n THEN
-        length := length - n
-      END;
-      sys.GET(str, c)
-    END;
-    WHILE (length > 0) OR (length = -1) & (c # 0X) DO
-      INC(str);
-      width := OutChar(Font^, ORD(c), x, y, canvas, bpp32, smoothing, color, params);
-      IF strike THEN
-        hline(canvas, x + ORD(1 IN BITS(params)) * ((Font.height DIV 2) DIV 3), y + Font.height DIV 2, width + 2, color, bpp32)
-      END;
-      IF underline THEN
-        hline(canvas, x, y + Font.height - 1, width + 2, color, bpp32)
-      END;
-      x := x + width;
-      IF x > xsize THEN
-        length := 0
-      END;
-      IF length > 0 THEN
-        DEC(length)
-      END;
-      IF length # 0 THEN
-        sys.GET(str, c)
-      END
-    END
-  END
-END TextOut;
-
-PROCEDURE SetSize*(_Font: TFont; font_size: INTEGER): BOOLEAN;
-VAR temp, offset, fsize, i, memsize, mem: INTEGER;
-    c: CHAR; Font, Font2: TFont_desc;
-BEGIN
-  offset := -1;
-  IF (MIN_FONT_SIZE <= font_size) & (font_size <= MAX_FONT_SIZE) & (_Font # NIL) THEN
-    Font := _Font^;
-    Font2 := Font;
-    temp := Font.data + (font_size - 8) * 4;
-    IF (Font.data <= temp) & (temp <= Font.size + Font.data - 4) THEN
-      sys.GET(temp, offset);
-      IF offset # -1 THEN
-        Font.font_size := font_size;
-        INC(offset, 156);
-        offset := offset + Font.data;
-        IF (Font.data <= offset) & (offset <= Font.size + Font.data - 4) THEN
-          sys.GET(offset, fsize);
-          IF fsize > 256 + 6 THEN
-            temp := offset + fsize - 1;
-            IF (Font.data <= temp) & (temp <= Font.size + Font.data - 1) THEN
-              sys.GET(temp, c);
-              IF c # 0X THEN
-                Font.height := ORD(c);
-                DEC(temp);
-                sys.GET(temp, c);
-                IF c # 0X THEN
-                  Font.width := ORD(c);
-                  DEC(fsize, 6);
-                  Font.char_size := fsize DIV 256;
-                  IF fsize MOD 256 # 0 THEN
-                    INC(Font.char_size)
-                  END;
-                  IF Font.char_size > 0 THEN
-                    Font.font := offset + 4;
-                    Font.mempos := 0;
-                    memsize := (Font.width + 10) * Font.height * 1024;
-                    mem := Font.mem;
-                    Font.mem := KOSAPI.sysfunc3(68, 12, memsize);
-                    IF Font.mem # 0 THEN
-                      IF mem # 0 THEN
-                        mem := KOSAPI.sysfunc3(68, 13, mem)
-                      END;
-                      zeromem(memsize DIV 4, Font.mem);
-                      FOR i := 0 TO 255 DO
-                        make_glyph(Font, i)
-                      END
-                    ELSE
-                      offset := -1
-                    END
-                  ELSE
-                    offset := -1
-                  END
-                ELSE
-                  offset := -1
-                END
-              ELSE
-                offset := -1
-              END
-            ELSE
-              offset := -1
-            END
-          ELSE
-            offset := -1
-          END
-        ELSE
-          offset := -1
-        END
-      END;
-    ELSE
-      offset := -1
-    END;
-    IF offset # -1 THEN
-      _Font^ := Font
-    ELSE
-      _Font^ := Font2
-    END
-  END
-  RETURN offset # -1
-END SetSize;
-
-PROCEDURE Enabled*(Font: TFont; font_size: INTEGER): BOOLEAN;
-VAR offset, temp: INTEGER;
-BEGIN
-  offset := -1;
-  IF (MIN_FONT_SIZE <= font_size) & (font_size <= MAX_FONT_SIZE) & (Font # NIL) THEN
-    temp := Font.data + (font_size - 8) * 4;
-    IF (Font.data <= temp) & (temp <= Font.size + Font.data - 4) THEN
-      sys.GET(temp, offset)
-    END
-  END
-  RETURN offset # -1
-END Enabled;
-
-PROCEDURE Destroy*(VAR Font: TFont);
-BEGIN
-  IF Font # NIL THEN
-    IF Font.mem # 0 THEN
-      Font.mem := KOSAPI.sysfunc3(68, 13, Font.mem)
-    END;
-    IF Font.data # 0 THEN
-      Font.data := KOSAPI.sysfunc3(68, 13, Font.data)
-    END;
-    DISPOSE(Font)
-  END
-END Destroy;
-
-PROCEDURE LoadFont*(file_name: ARRAY OF CHAR): TFont;
-VAR Font: TFont; data, size, n: INTEGER;
-BEGIN
-  data := File.Load(file_name, size);
-  IF (data # 0) & (size > 156) THEN
-    NEW(Font);
-    Font.data := data;
-    Font.size := size;
-    Font.font_size := 0;
-    n := MIN_FONT_SIZE;
-    WHILE ~SetSize(Font, n) & (n <= MAX_FONT_SIZE) DO
-      INC(n)
-    END;
-    IF Font.font_size = 0 THEN
-      Destroy(Font)
-    END
-  ELSE
-    IF data # 0 THEN
-      data := KOSAPI.sysfunc3(68, 13, data)
-    END;
-    Font := NIL
-  END
-  RETURN Font
-END LoadFont;
-
-END kfonts.

programs/develop/oberon07/lib/KolibriOS/libimg.ob07

@@ -1,435 +0,0 @@
-(*
-    Copyright 2016, 2018, 2020, 2022 KolibriOS team
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*)
-
-MODULE libimg;
-
-IMPORT sys := SYSTEM, KOSAPI;
-
-
-CONST
-
-  FLIP_VERTICAL   *= 1;
-  FLIP_HORIZONTAL *= 2;
-
-
-  ROTATE_90_CW    *= 1;
-  ROTATE_180      *= 2;
-  ROTATE_270_CW   *= 3;
-  ROTATE_90_CCW   *= ROTATE_270_CW;
-  ROTATE_270_CCW  *= ROTATE_90_CW;
-
-
-  // scale type                       corresponding img_scale params
-  LIBIMG_SCALE_INTEGER     *= 1;  //    scale factor ; reserved 0
-  LIBIMG_SCALE_TILE        *= 2;  //    new width    ; new height
-  LIBIMG_SCALE_STRETCH     *= 3;  //    new width    ; new height
-  LIBIMG_SCALE_FIT_RECT    *= 4;  //    new width    ; new height
-  LIBIMG_SCALE_FIT_WIDTH   *= 5;  //    new width    ; new height
-  LIBIMG_SCALE_FIT_HEIGHT  *= 6;  //    new width    ; new height
-  LIBIMG_SCALE_FIT_MAX     *= 7;  //    new width    ; new height
-
-
-  // interpolation algorithm
-  LIBIMG_INTER_NONE        *= 0;  //    use it with LIBIMG_SCALE_INTEGER, LIBIMG_SCALE_TILE, etc
-  LIBIMG_INTER_BILINEAR    *= 1;
-  LIBIMG_INTER_DEFAULT     *= LIBIMG_INTER_BILINEAR;
-
-
-  // list of format id's
-  LIBIMG_FORMAT_BMP        *=  1;
-  LIBIMG_FORMAT_ICO        *=  2;
-  LIBIMG_FORMAT_CUR        *=  3;
-  LIBIMG_FORMAT_GIF        *=  4;
-  LIBIMG_FORMAT_PNG        *=  5;
-  LIBIMG_FORMAT_JPEG       *=  6;
-  LIBIMG_FORMAT_TGA        *=  7;
-  LIBIMG_FORMAT_PCX        *=  8;
-  LIBIMG_FORMAT_XCF        *=  9;
-  LIBIMG_FORMAT_TIFF       *= 10;
-  LIBIMG_FORMAT_PNM        *= 11;
-  LIBIMG_FORMAT_WBMP       *= 12;
-  LIBIMG_FORMAT_XBM        *= 13;
-  LIBIMG_FORMAT_Z80        *= 14;
-
-
-  // encode flags (byte 0x02 of common option)
-  LIBIMG_ENCODE_STRICT_SPECIFIC   *= 01H;
-  LIBIMG_ENCODE_STRICT_BIT_DEPTH  *= 02H;
-  LIBIMG_ENCODE_DELETE_ALPHA      *= 08H;
-  LIBIMG_ENCODE_FLUSH_ALPHA       *= 10H;
-
-
-  // values for Image.Type
-  // must be consecutive to allow fast switch on Image.Type in support functions
-  bpp8i  *=   1;  // indexed
-  bpp24  *=   2;
-  bpp32  *=   3;
-  bpp15  *=   4;
-  bpp16  *=   5;
-  bpp1   *=   6;
-  bpp8g  *=   7;  // grayscale
-  bpp2i  *=   8;
-  bpp4i  *=   9;
-  bpp8a  *=  10;  // grayscale with alpha channel; application layer only!!! kernel doesn't handle this image type, libimg can only create and destroy such images
-
-
-  // bits in Image.Flags
-  IsAnimated *= 1;
-
-
-TYPE
-
-  Image* = RECORD
-
-    Checksum  *: INTEGER;
-    Width     *: INTEGER;
-    Height    *: INTEGER;
-    Next      *: INTEGER;
-    Previous  *: INTEGER;
-    Type      *: INTEGER; // one of bppN
-    Data      *: INTEGER;
-    Palette   *: INTEGER; // used iff Type eq bpp1, bpp2, bpp4 or bpp8i
-    Extended  *: INTEGER;
-    Flags     *: INTEGER; // bitfield
-    Delay     *: INTEGER  // used iff IsAnimated is set in Flags
-
-  END;
-
-
-  ImageDecodeOptions* = RECORD
-
-    UsedSize         *: INTEGER; // if >=8, the field BackgroundColor is valid, and so on
-    BackgroundColor  *: INTEGER  // used for transparent images as background
-
-  END;
-
-
-  FormatsTableEntry* = RECORD
-
-    Format_id     *: INTEGER;
-    Is            *: INTEGER;
-    Decode        *: INTEGER;
-    Encode        *: INTEGER;
-    Capabilities  *: INTEGER
-
-  END;
-
-
-VAR
-
-    img_is_img         *: PROCEDURE (data, length: INTEGER): INTEGER;
-
-
-
-    img_to_rgb2        *: PROCEDURE (img: INTEGER; out: INTEGER);
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? decodes image data into RGB triplets and stores them where out points to                       ;;
-;;------------------------------------------------------------------------------------------------;;
-;> img = pointer to source image                                                                  ;;
-;> out = where to store RGB triplets                                                              ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_to_rgb         *: PROCEDURE (img: INTEGER): INTEGER;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? decodes image data into RGB triplets and returns pointer to memory area containing them        ;;
-;;------------------------------------------------------------------------------------------------;;
-;> img = pointer to source image                                                                  ;;
-;;------------------------------------------------------------------------------------------------;;
-;< 0 / pointer to rgb_data (array of [rgb] triplets)                                              ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_decode         *: PROCEDURE (data, length, options: INTEGER): INTEGER;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? decodes loaded into memory graphic file                                                        ;;
-;;------------------------------------------------------------------------------------------------;;
-;> data    = pointer to file in memory                                                            ;;
-;> length  = size in bytes of memory area pointed to by data                                      ;;
-;> options = 0 / pointer to the structure of additional options                                   ;;
-;;------------------------------------------------------------------------------------------------;;
-;< 0 / pointer to image                                                                           ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_encode         *: PROCEDURE (img: INTEGER; common, specific: INTEGER): INTEGER;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? encode image to some format                                                                    ;;
-;;------------------------------------------------------------------------------------------------;;
-;> img      = pointer to input image                                                              ;;
-;> common   = some most important options                                                         ;;
-;     0x00 :  byte : format id                                                                    ;;
-;     0x01 :  byte : fast encoding (0) / best compression ratio (255)                             ;;
-;                    0 : store uncompressed data (if supported both by the format and libimg)     ;;
-;                    1 - 255 : use compression, if supported                                      ;;
-;                    this option may be ignored if any format specific options are defined        ;;
-;                    i.e. the 0 here will be ignored if some compression algorithm is specified   ;;
-;     0x02 :  byte : flags (bitfield)                                                             ;;
-;                   0x01 : return an error if format specific conditions cannot be met            ;;
-;                   0x02 : preserve current bit depth. means 8bpp/16bpp/24bpp and so on           ;;
-;                   0x04 : delete alpha channel, if any                                           ;;
-;                   0x08 : flush alpha channel with 0xff, if any; add it if none                  ;;
-;     0x03 :  byte : reserved, must be 0                                                          ;;
-;> specific = 0 / pointer to the structure of format specific options                             ;;
-;                   see <format_name>.inc for description                                         ;;
-;;------------------------------------------------------------------------------------------------;;
-;< 0 / pointer to encoded data                                                                    ;;
-;;================================================================================================;;
-  *)
-
-
-
-    img_create         *: PROCEDURE (width, height, _type: INTEGER): INTEGER;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? creates an Image structure and initializes some its fields                                     ;;
-;;------------------------------------------------------------------------------------------------;;
-;> width  = width of an image in pixels                                                           ;;
-;> height = height of an image in pixels                                                          ;;
-;> type   = one of the bppN constants                                                             ;;
-;;------------------------------------------------------------------------------------------------;;
-;< 0 / pointer to image                                                                           ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_destroy        *: PROCEDURE (img: INTEGER): BOOLEAN;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? frees memory occupied by an image and all the memory regions its fields point to               ;;
-;? follows Previous/Next pointers and deletes all the images in sequence                          ;;
-;;------------------------------------------------------------------------------------------------;;
-;> img = pointer to image                                                                         ;;
-;;------------------------------------------------------------------------------------------------;;
-;< FALSE (fail) / TRUE (success)                                                                  ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_destroy_layer  *: PROCEDURE (img: INTEGER): BOOLEAN;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? frees memory occupied by an image and all the memory regions its fields point to               ;;
-;? for image sequences deletes only one frame and fixes Previous/Next pointers                    ;;
-;;------------------------------------------------------------------------------------------------;;
-;> img = pointer to image                                                                         ;;
-;;------------------------------------------------------------------------------------------------;;
-;< FALSE (fail) / TRUE (success)                                                                  ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_count          *: PROCEDURE (img: INTEGER): INTEGER;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? Get number of images in the list (e.g. in animated GIF file)                                   ;;
-;;------------------------------------------------------------------------------------------------;;
-;> img = pointer to image                                                                         ;;
-;;------------------------------------------------------------------------------------------------;;
-;< -1 (fail) / >0 (ok)                                                                            ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_flip           *: PROCEDURE (img: INTEGER; flip_kind: INTEGER): BOOLEAN;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? Flip all layers of image                                                                       ;;
-;;------------------------------------------------------------------------------------------------;;
-;> img = pointer to image                                                                         ;;
-;> flip_kind = one of FLIP_* constants                                                            ;;
-;;------------------------------------------------------------------------------------------------;;
-;< FALSE / TRUE                                                                                   ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_flip_layer     *: PROCEDURE (img: INTEGER; flip_kind: INTEGER): BOOLEAN;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? Flip image layer                                                                               ;;
-;;------------------------------------------------------------------------------------------------;;
-;> img = pointer to image                                                                         ;;
-;> flip_kind = one of FLIP_* constants                                                            ;;
-;;------------------------------------------------------------------------------------------------;;
-;< FALSE / TRUE                                                                                   ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_rotate         *: PROCEDURE (img: INTEGER; rotate_kind: INTEGER): BOOLEAN;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? Rotate all layers of image                                                                     ;;
-;;------------------------------------------------------------------------------------------------;;
-;> img = pointer to image                                                                         ;;
-;> rotate_kind = one of ROTATE_* constants                                                        ;;
-;;------------------------------------------------------------------------------------------------;;
-;< FALSE / TRUE                                                                                   ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_rotate_layer   *: PROCEDURE (img: INTEGER; rotate_kind: INTEGER): BOOLEAN;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? Rotate image layer                                                                             ;;
-;;------------------------------------------------------------------------------------------------;;
-;> img = pointer to image                                                                         ;;
-;> rotate_kind = one of ROTATE_* constants                                                        ;;
-;;------------------------------------------------------------------------------------------------;;
-;< FALSE / TRUE                                                                                   ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_draw           *: PROCEDURE (img: INTEGER; x, y, width, height, xpos, ypos: INTEGER);
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? Draw image in the window                                                                       ;;
-;;------------------------------------------------------------------------------------------------;;
-;> img = pointer to image                                                                         ;;
-;> x = x-coordinate in the window                                                                 ;;
-;> y = y-coordinate in the window                                                                 ;;
-;> width = maximum width to draw                                                                  ;;
-;> height = maximum height to draw                                                                ;;
-;> xpos = offset in image by x-axis                                                               ;;
-;> ypos = offset in image by y-axis                                                               ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_scale          *: PROCEDURE (src: INTEGER; crop_x, crop_y, crop_width, crop_height: INTEGER; dst: INTEGER; scale, inter, param1, param2: INTEGER ): INTEGER;
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? scale _image                                                                                   ;;
-;;------------------------------------------------------------------------------------------------;;
-;> src         = pointer to source image                                                          ;;
-;> crop_x      = left coord of cropping rect                                                      ;;
-;> crop_y      = top coord of cropping rect                                                       ;;
-;> crop_width  = width of cropping rect                                                           ;;
-;> crop_height = height of cropping rect                                                          ;;
-;> dst         = pointer to resulting image / 0                                                   ;;
-;> scale       = how to change width and height. see libimg.inc                                   ;;
-;> inter       = interpolation algorithm                                                          ;;
-;> param1      = see libimg.inc                                                                   ;;
-;> param2      = see libimg.inc                                                                   ;;
-;;------------------------------------------------------------------------------------------------;;
-;< 0 / pointer to scaled image                                                                    ;;
-;;================================================================================================;;
-*)
-
-
-
-    img_convert        *: PROCEDURE (src, dst: INTEGER; dst_type, flags, param: INTEGER);
-(*
-;;------------------------------------------------------------------------------------------------;;
-;? scale _image                                                                                   ;;
-;;------------------------------------------------------------------------------------------------;;
-;> src      = pointer to source image                                                             ;;
-;> flags    = see libimg.inc                                                                      ;;
-;> dst_type = the Image.Type of converted image                                                   ;;
-;> dst      = pointer to destination image, if any                                                ;;
-;;------------------------------------------------------------------------------------------------;;
-;< 0 / pointer to converted image                                                                 ;;
-;;================================================================================================;;
-*)
-
-
-    img_formats_table  *: ARRAY 20 OF FormatsTableEntry;
-
-
-
-PROCEDURE GetImageStruct* (img: INTEGER; VAR ImageStruct: Image): BOOLEAN;
-BEGIN
-  IF img # 0 THEN
-    sys.MOVE(img, sys.ADR(ImageStruct), sys.SIZE(Image))
-  END
-  RETURN img # 0
-END GetImageStruct;
-
-
-PROCEDURE GetFormatsTable(ptr: INTEGER);
-VAR i: INTEGER; eot: BOOLEAN;
-BEGIN
-  i := 0;
-  REPEAT
-    sys.MOVE(ptr, sys.ADR(img_formats_table[i]), sys.SIZE(FormatsTableEntry));
-    ptr := ptr + sys.SIZE(FormatsTableEntry);
-    eot := img_formats_table[i].Format_id = 0;
-    INC(i)
-  UNTIL eot OR (i = LEN(img_formats_table))
-END GetFormatsTable;
-
-
-PROCEDURE main;
-VAR Lib, formats_table_ptr: INTEGER;
-
-  PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
-  VAR a: INTEGER;
-  BEGIN
-    a := KOSAPI.GetProcAdr(name, Lib);
-    ASSERT(a # 0);
-    sys.PUT(v, a)
-  END GetProc;
-
-BEGIN
-  Lib := KOSAPI.LoadLib("/sys/lib/libimg.obj");
-  ASSERT(Lib # 0);
-  GetProc(Lib, sys.ADR(img_is_img)        , "img_is_img");
-  GetProc(Lib, sys.ADR(img_to_rgb)        , "img_to_rgb");
-  GetProc(Lib, sys.ADR(img_to_rgb2)       , "img_to_rgb2");
-  GetProc(Lib, sys.ADR(img_decode)        , "img_decode");
-  GetProc(Lib, sys.ADR(img_encode)        , "img_encode");
-  GetProc(Lib, sys.ADR(img_create)        , "img_create");
-  GetProc(Lib, sys.ADR(img_destroy)       , "img_destroy");
-  GetProc(Lib, sys.ADR(img_destroy_layer) , "img_destroy_layer");
-  GetProc(Lib, sys.ADR(img_count)         , "img_count");
-  GetProc(Lib, sys.ADR(img_flip)          , "img_flip");
-  GetProc(Lib, sys.ADR(img_flip_layer)    , "img_flip_layer");
-  GetProc(Lib, sys.ADR(img_rotate)        , "img_rotate");
-  GetProc(Lib, sys.ADR(img_rotate_layer)  , "img_rotate_layer");
-  GetProc(Lib, sys.ADR(img_draw)          , "img_draw");
-  GetProc(Lib, sys.ADR(img_scale)         , "img_scale");
-  GetProc(Lib, sys.ADR(img_convert)       , "img_convert");
-  GetProc(Lib, sys.ADR(formats_table_ptr) , "img_formats_table");
-  GetFormatsTable(formats_table_ptr)
-END main;
-
-
-BEGIN
-  main
-END libimg.

programs/develop/oberon07/lib/Math/CMath.ob07

@@ -1,462 +0,0 @@
-(* ***********************************************
-    Модуль работы с комплексными числами.
-    Вадим Исаев, 2020
-    Module for complex numbers.
-    Vadim Isaev, 2020
-*************************************************** *)
-
-MODULE CMath;
-
-IMPORT Math, Out;
-
-TYPE
-  complex* = POINTER TO RECORD
-    re*: REAL;
-    im*: REAL
-  END;
-
-VAR
-  result: complex;
-
-  i* : complex;
-  _0*: complex;
-
-(* Инициализация комплексного числа.
-   Init complex number. *)
-PROCEDURE CInit* (re : REAL; im: REAL): complex;
-VAR
-  temp: complex;
-BEGIN
-  NEW(temp);
-  temp.re:=re;
-  temp.im:=im;
-
-  RETURN temp
-END CInit;
-
-
-(* Четыре основных арифметических операций.
-   Four base operations  +, -, * , / *)
-
-(* Сложение
-   addition : z := z1 + z2 *)
-PROCEDURE CAdd* (z1, z2: complex): complex;
-BEGIN
-  result.re := z1.re + z2.re;
-  result.im := z1.im + z2.im;
-
-  RETURN result
-END CAdd;
-
-(* Сложение с REAL.
-   addition : z := z1 + r1 *)
-PROCEDURE CAdd_r* (z1: complex; r1: REAL): complex;
-BEGIN
-  result.re := z1.re + r1;
-  result.im := z1.im;
-
-  RETURN result
-END CAdd_r;
-
-(* Сложение с INTEGER.
-   addition : z := z1 + i1 *)
-PROCEDURE CAdd_i* (z1: complex; i1: INTEGER): complex;
-BEGIN
-  result.re := z1.re + FLT(i1);
-  result.im := z1.im;
-
-  RETURN result
-END CAdd_i;
-
-(* Смена знака.
-   substraction : z := - z1 *)
-PROCEDURE CNeg (z1 : complex): complex;
-BEGIN
-  result.re := -z1.re;
-  result.im := -z1.im;
-
-  RETURN result
-END CNeg;
-
-(* Вычитание.
-   substraction : z := z1 - z2 *)
-PROCEDURE CSub* (z1, z2 : complex): complex;
-BEGIN
-  result.re := z1.re - z2.re;
-  result.im := z1.im - z2.im;
-
-  RETURN result
-END CSub;
-
-(* Вычитание REAL.
-   substraction : z := z1 - r1 *)
-PROCEDURE CSub_r1* (z1 : complex; r1 : REAL): complex;
-BEGIN
-  result.re := z1.re - r1;
-  result.im := z1.im;
-
-  RETURN result
-END CSub_r1;
-
-(* Вычитание из REAL.
-   substraction : z := r1 - z1 *)
-PROCEDURE CSub_r2* (r1 : REAL; z1 : complex): complex;
-BEGIN
-  result.re := r1 - z1.re;
-  result.im := - z1.im;
-
-  RETURN result
-END CSub_r2;
-
-(* Вычитание INTEGER.
-   substraction : z := z1 - i1 *)
-PROCEDURE CSub_i* (z1 : complex; i1 : INTEGER): complex;
-BEGIN
-  result.re := z1.re - FLT(i1);
-  result.im := z1.im;
-
-  RETURN result
-END CSub_i;
-
-(* Умножение.
-   multiplication : z := z1 * z2 *)
-PROCEDURE CMul (z1, z2 : complex): complex;
-BEGIN
-  result.re := (z1.re * z2.re) - (z1.im * z2.im);
-  result.im := (z1.re * z2.im) + (z1.im * z2.re);
-
-  RETURN result
-END CMul;
-
-(* Умножение с REAL.
-   multiplication : z := z1 * r1 *)
-PROCEDURE CMul_r (z1 : complex; r1 : REAL): complex;
-BEGIN
-  result.re := z1.re * r1;
-  result.im := z1.im * r1;
-
-  RETURN result
-END CMul_r;
-
-(* Умножение с INTEGER.
-   multiplication : z := z1 * i1 *)
-PROCEDURE CMul_i (z1 : complex; i1 : INTEGER): complex;
-BEGIN
-  result.re := z1.re * FLT(i1);
-  result.im := z1.im * FLT(i1);
-
-  RETURN result
-END CMul_i;
-
-(* Деление.
-   division : z := znum / zden *)
-PROCEDURE CDiv (z1, z2 : complex): complex;
-    (* The following algorithm is used to properly handle
-      denominator overflow:
-
-                 |  a + b(d/c)   c - a(d/c)
-                 |  ---------- + ---------- I     if |d| < |c|
-      a + b I    |  c + d(d/c)   a + d(d/c)
-      -------  = |
-      c + d I    |  b + a(c/d)   -a+ b(c/d)
-                 |  ---------- + ---------- I     if |d| >= |c|
-                 |  d + c(c/d)   d + c(c/d)
-    *)
-VAR
-  tmp, denom : REAL;
-BEGIN
-   IF ( ABS(z2.re) > ABS(z2.im) ) THEN
-     tmp := z2.im / z2.re;
-     denom := z2.re + z2.im * tmp;
-     result.re := (z1.re + z1.im * tmp) / denom;
-     result.im := (z1.im - z1.re * tmp) / denom;
-   ELSE
-     tmp := z2.re / z2.im;
-     denom := z2.im + z2.re * tmp;
-     result.re := (z1.im + z1.re * tmp) / denom;
-     result.im := (-z1.re + z1.im * tmp) / denom;
-   END;
-
-   RETURN result
-END CDiv;
-
-(* Деление на REAL.
-   division : z := znum / r1 *)
-PROCEDURE CDiv_r* (z1 : complex; r1 : REAL): complex;
-BEGIN
-  result.re := z1.re / r1;
-  result.im := z1.im / r1;
-
-  RETURN result
-END CDiv_r;
-
-(* Деление на INTEGER.
-   division : z := znum / i1 *)
-PROCEDURE CDiv_i* (z1 : complex; i1 : INTEGER): complex;
-BEGIN
-  result.re := z1.re / FLT(i1);
-  result.im := z1.im / FLT(i1);
-
-  RETURN result
-END CDiv_i;
-
-(* fonctions elementaires *)
-
-(* Вывод на экран.
-   out complex number *)
-PROCEDURE CPrint* (z: complex; width: INTEGER);
-BEGIN
-  Out.Real(z.re, width);
-  IF z.im>=0.0 THEN
-    Out.String("+");
-  END;
-  Out.Real(z.im, width);
-  Out.String("i");
-END CPrint;
-
-PROCEDURE CPrintLn* (z: complex; width: INTEGER);
-BEGIN
-  CPrint(z, width);
-  Out.Ln;
-END CPrintLn;
-
-(* Вывод на экран с фиксированным кол-вом знаков
-   после запятой (p) *)
-PROCEDURE CPrintFix* (z: complex; width, p: INTEGER);
-BEGIN
-  Out.FixReal(z.re, width, p);
-  IF z.im>=0.0 THEN
-    Out.String("+");
-  END;
-  Out.FixReal(z.im, width, p);
-  Out.String("i");
-END CPrintFix;
-
-PROCEDURE CPrintFixLn* (z: complex; width, p: INTEGER);
-BEGIN
-  CPrintFix(z, width, p);
-  Out.Ln;
-END CPrintFixLn;
-
-(* Модуль числа.
-   module : r = |z| *)
-PROCEDURE CMod* (z1 : complex): REAL;
-BEGIN
-  RETURN Math.sqrt((z1.re * z1.re) + (z1.im * z1.im))
-END CMod;
-
-(* Квадрат числа.
-   square : r := z*z *)
-PROCEDURE CSqr* (z1: complex): complex;
-BEGIN
-  result.re := z1.re * z1.re - z1.im * z1.im;
-  result.im := 2.0 * z1.re * z1.im;
-
-  RETURN result
-END CSqr;
-
-(* Квадратный корень числа.
-   square root : r := sqrt(z) *)
-PROCEDURE CSqrt* (z1: complex): complex;
-VAR
-  root, q: REAL;
-BEGIN
-  IF (z1.re#0.0) OR (z1.im#0.0) THEN
-    root := Math.sqrt(0.5 * (ABS(z1.re) + CMod(z1)));
-    q := z1.im / (2.0 * root);
-    IF z1.re >= 0.0 THEN
-      result.re := root;
-      result.im := q;
-    ELSE
-      IF z1.im < 0.0 THEN
-        result.re := - q;
-        result.im := - root
-      ELSE
-        result.re :=  q;
-        result.im :=  root
-      END
-    END
-  ELSE
-    result := z1;
-  END;
-
-  RETURN result
-END CSqrt;
-
-(* Экспонента.
-   exponantial : r := exp(z) *)
-(* exp(x + iy) = exp(x).exp(iy) = exp(x).[cos(y) + i sin(y)] *)
-PROCEDURE CExp* (z: complex): complex;
-VAR
-  expz : REAL;
-BEGIN
-  expz := Math.exp(z.re);
-  result.re := expz * Math.cos(z.im);
-  result.im := expz * Math.sin(z.im);
-
-  RETURN result
-END CExp;
-
-(* Натуральный логарифм.
-   natural logarithm : r := ln(z) *)
-(* ln( p exp(i0)) = ln(p) + i0 + 2kpi *)
-PROCEDURE CLn* (z: complex): complex;
-BEGIN
-  result.re := Math.ln(CMod(z));
-  result.im := Math.arctan2(z.im, z.re);
-
-  RETURN result
-END CLn;
-
-(* Число в степени.
-   exp : z := z1^z2 *)
-PROCEDURE CPower* (z1, z2 : complex): complex;
-VAR
-  a: complex;
-BEGIN
-   a:=CLn(z1);
-   a:=CMul(z2, a);
-   result:=CExp(a);
-
-   RETURN result
-END CPower;
-
-(* Число в степени REAL.
-   multiplication : z := z1^r *)
-PROCEDURE CPower_r* (z1: complex; r: REAL): complex;
-VAR
-  a: complex;
-BEGIN
-  a:=CLn(z1);
-  a:=CMul_r(a, r);
-  result:=CExp(a);
-
-  RETURN result
-END CPower_r;
-
-(* Обратное число.
-   inverse : r := 1 / z *)
-PROCEDURE CInv* (z: complex): complex;
-VAR
-  denom : REAL;
-BEGIN
-  denom := (z.re * z.re) + (z.im * z.im);
-  (* generates a fpu exception if denom=0 as for reals *)
-  result.re:=z.re/denom;
-  result.im:=-z.im/denom;
-
-  RETURN result
-END CInv;
-
-(* direct trigonometric functions *)
-
-(* Косинус.
-   complex cosinus *)
-(* cos(x+iy) = cos(x).cos(iy) - sin(x).sin(iy) *)
-(* cos(ix) = cosh(x) et sin(ix) = i.sinh(x) *)
-PROCEDURE CCos* (z: complex): complex;
-BEGIN
-  result.re := Math.cos(z.re) * Math.cosh(z.im);
-  result.im := - Math.sin(z.re) * Math.sinh(z.im);
-
-  RETURN result
-END CCos;
-
-(* Синус.
-   sinus complex *)
-(* sin(x+iy) = sin(x).cos(iy) + cos(x).sin(iy) *)
-(* cos(ix) = cosh(x) et sin(ix) = i.sinh(x) *)
-PROCEDURE CSin (z: complex): complex;
-BEGIN
-  result.re := Math.sin(z.re) * Math.cosh(z.im);
-  result.im := Math.cos(z.re) * Math.sinh(z.im);
-
-  RETURN result
-END CSin;
-
-(* Тангенс.
-   tangente *)
-PROCEDURE CTg* (z: complex): complex;
-VAR
-  temp1, temp2: complex;
-BEGIN
-  temp1:=CSin(z);
-  temp2:=CCos(z);
-  result:=CDiv(temp1, temp2);
-
-  RETURN result
-END CTg;
-
-(* inverse complex hyperbolic functions *)
-
-(* Гиперболический арккосинус.
-   hyberbolic arg cosinus *)
-(*                          _________  *)
-(* argch(z) = -/+ ln(z + i.V 1 - z.z)  *)
-PROCEDURE CArcCosh* (z : complex): complex;
-BEGIN
-  result:=CNeg(CLn(CAdd(z, CMul(i, CSqrt(CSub_r2(1.0, CMul(z, z)))))));
-
-  RETURN result
-END CArcCosh;
-
-(* Гиперболический арксинус.
-   hyperbolic arc sinus       *)
-(*                    ________  *)
-(* argsh(z) = ln(z + V 1 + z.z) *)
-PROCEDURE CArcSinh* (z : complex): complex;
-BEGIN
-  result:=CLn(CAdd(z, CSqrt(CAdd_r(CMul(z, z), 1.0))));
-
-  RETURN result
-END CArcSinh;
-
-(* Гиперболический арктангенс.
-   hyperbolic arc tangent *)
-(* argth(z) = 1/2 ln((z + 1) / (1 - z)) *)
-PROCEDURE CArcTgh (z : complex): complex;
-BEGIN
-  result:=CDiv_r(CLn(CDiv(CAdd_r(z, 1.0), CSub_r2(1.0, z))), 2.0);
-
-  RETURN result
-END CArcTgh;
-
-(* trigonometriques inverses *)
-
-(* Арккосинус.
-   arc cosinus complex *)
-(* arccos(z) = -i.argch(z) *)
-PROCEDURE CArcCos* (z: complex): complex;
-BEGIN
-  result := CNeg(CMul(i, CArcCosh(z)));
-
-  RETURN result
-END CArcCos;
-
-(* Арксинус.
-   arc sinus complex *)
-(* arcsin(z) = -i.argsh(i.z) *)
-PROCEDURE CArcSin* (z : complex): complex;
-BEGIN
-  result := CNeg(CMul(i, CArcSinh(z)));
-
-  RETURN result
-END CArcSin;
-
-(* Арктангенс.
-   arc tangente complex *)
-(* arctg(z) = -i.argth(i.z) *)
-PROCEDURE CArcTg* (z : complex): complex;
-BEGIN
-  result := CNeg(CMul(i, CArcTgh(CMul(i, z))));
-
-  RETURN result
-END CArcTg;
-
-BEGIN
-
-  result:=CInit(0.0, 0.0);
-  i :=CInit(0.0, 1.0);
-  _0:=CInit(0.0, 0.0);
-
-END CMath.

programs/develop/oberon07/lib/Math/MathBits.ob07

@@ -1,33 +0,0 @@
-(* ****************************************
-   Дополнение к модулю Math.
-   Побитовые операции над целыми числами.
-   Вадим Исаев, 2020
-   Additional functions to the module Math.
-   Bitwise operations on integers.
-   Vadim Isaev, 2020
-******************************************* *)
-
-MODULE MathBits;
-
-
-PROCEDURE iand* (x, y: INTEGER): INTEGER;
-    RETURN ORD(BITS(x) * BITS(y))
-END iand;
-
-
-PROCEDURE ior* (x, y: INTEGER): INTEGER;
-    RETURN ORD(BITS(x) + BITS(y))
-END ior;
-
-
-PROCEDURE ixor* (x, y: INTEGER): INTEGER;
-    RETURN ORD(BITS(x) / BITS(y))
-END ixor;
-
-
-PROCEDURE inot* (x: INTEGER): INTEGER;
-    RETURN ORD(-BITS(x))
-END inot;
-
-
-END MathBits.

programs/develop/oberon07/lib/Math/MathRound.ob07

@@ -1,99 +0,0 @@
-(* ******************************************
-   Дополнительные функции к модулю Math.
-   Функции округления.
-   Вадим Исаев, 2020
-   -------------------------------------
-   Additional functions to the module Math.
-   Rounding functions.
-   Vadim Isaev, 2020
-********************************************* *)
-
-MODULE MathRound;
-
-IMPORT Math;
-
-
-(* Возвращается целая часть числа x.
-   Returns the integer part of a argument x.*)
-PROCEDURE trunc* (x: REAL): REAL;
-VAR
-    a: REAL;
-
-BEGIN
-    a := FLT(FLOOR(x));
-    IF (x < 0.0) & (x # a) THEN
-        a := a + 1.0
-    END
-
-    RETURN a
-END trunc;
-
-
-(* Возвращается дробная часть числа x.
-   Returns the fractional part of the argument x *)
-PROCEDURE frac* (x: REAL): REAL;
-    RETURN x - trunc(x)
-END frac;
-
-
-(* Округление к ближайшему целому.
-   Rounding to the nearest integer. *)
-PROCEDURE round* (x: REAL): REAL;
-VAR
-    a: REAL;
-
-BEGIN
-    a := trunc(x);
-    IF ABS(frac(x)) >= 0.5 THEN
-        a := a + FLT(Math.sgn(x))
-    END
-
-    RETURN a
-END round;
-
-
-(* Округление к бОльшему целому.
-   Rounding to a largest integer *)
-PROCEDURE ceil* (x: REAL): REAL;
-VAR
-    a: REAL;
-
-BEGIN
-    a := FLT(FLOOR(x));
-    IF x # a THEN
-        a := a + 1.0
-    END
-
-    RETURN a
-END ceil;
-
-
-(* Округление к меньшему целому.
-   Rounding to a smallest integer *)
-PROCEDURE floor* (x: REAL): REAL;
-    RETURN FLT(FLOOR(x))
-END floor;
-
-
-(* Округление до определённого количества знаков:
-   - если Digits отрицательное, то округление
-     в знаках после десятичной запятой;
-   - если Digits положительное, то округление
-     в знаках до запятой  *)
-PROCEDURE SimpleRoundTo* (AValue: REAL; Digits: INTEGER): REAL;
-VAR
-    RV, a : REAL;
-
-BEGIN
-    RV := Math.ipower(10.0, -Digits);
-    IF AValue < 0.0 THEN
-        a := trunc((AValue * RV) - 0.5)
-    ELSE
-        a := trunc((AValue * RV) + 0.5)
-    END
-
-    RETURN a / RV
-END SimpleRoundTo;
-
-
-END MathRound.

programs/develop/oberon07/lib/Math/MathStat.ob07

@@ -1,238 +0,0 @@
-(* ********************************************
-   Дополнение к модулю Math.
-   Статистические процедуры.
-   -------------------------------------
-   Additional functions to the module Math.
-   Statistical functions
-*********************************************** *)
-
-MODULE MathStat;
-
-IMPORT Math;
-
-
-(*Минимальное значение. Нецелое *)
-PROCEDURE MinValue* (data: ARRAY OF REAL; N: INTEGER): REAL;
-VAR
-    i: INTEGER;
-    a: REAL;
-
-BEGIN
-    a := data[0];
-    FOR i := 1 TO N - 1 DO
-        IF data[i] < a THEN
-            a := data[i]
-        END
-    END
-
-    RETURN a
-END MinValue;
-
-
-(*Минимальное значение. Целое *)
-PROCEDURE MinIntValue* (data: ARRAY OF INTEGER; N: INTEGER): INTEGER;
-VAR
-    i: INTEGER;
-    a: INTEGER;
-
-BEGIN
-    a := data[0];
-    FOR i := 1 TO N - 1 DO
-        IF data[i] < a THEN
-            a := data[i]
-        END
-    END
-
-    RETURN a
-END MinIntValue;
-
-
-(*Максимальное значение. Нецелое *)
-PROCEDURE MaxValue* (data: ARRAY OF REAL; N: INTEGER): REAL;
-VAR
-    i: INTEGER;
-    a: REAL;
-
-BEGIN
-    a := data[0];
-    FOR i := 1 TO N - 1 DO
-        IF data[i] > a THEN
-            a := data[i]
-        END
-    END
-
-    RETURN a
-END MaxValue;
-
-
-(*Максимальное значение. Целое *)
-PROCEDURE MaxIntValue* (data: ARRAY OF INTEGER; N: INTEGER): INTEGER;
-VAR
-    i: INTEGER;
-    a: INTEGER;
-
-BEGIN
-    a := data[0];
-    FOR i := 1 TO N - 1 DO
-        IF data[i] > a THEN
-            a := data[i]
-        END
-    END
-
-    RETURN a
-END MaxIntValue;
-
-
-(* Сумма значений массива *)
-PROCEDURE Sum* (data: ARRAY OF REAL; Count: INTEGER): REAL;
-VAR
-    a: REAL;
-    i: INTEGER;
-
-BEGIN
-    a := 0.0;
-    FOR i := 0 TO Count - 1 DO
-        a := a + data[i]
-    END
-
-    RETURN a
-END Sum;
-
-
-(* Сумма целых значений массива *)
-PROCEDURE SumInt* (data: ARRAY OF INTEGER; Count: INTEGER): INTEGER;
-VAR
-    a: INTEGER;
-    i: INTEGER;
-
-BEGIN
-    a := 0;
-    FOR i := 0 TO Count - 1 DO
-        a := a + data[i]
-    END
-
-    RETURN a
-END SumInt;
-
-
-(* Сумма квадратов значений массива *)
-PROCEDURE SumOfSquares* (data : ARRAY OF REAL; Count: INTEGER): REAL;
-VAR
-    a: REAL;
-    i: INTEGER;
-
-BEGIN
-    a := 0.0;
-    FOR i := 0 TO Count - 1 DO
-        a := a + Math.sqrr(data[i])
-    END
-
-    RETURN a
-END SumOfSquares;
-
-
-(* Сумма значений и сумма квадратов значений массмва *)
-PROCEDURE SumsAndSquares* (data: ARRAY OF REAL; Count : INTEGER;
-                            VAR sum, sumofsquares : REAL);
-VAR
-    i: INTEGER;
-    temp: REAL;
-
-BEGIN
-    sumofsquares := 0.0;
-    sum := 0.0;
-    FOR i := 0 TO Count - 1 DO
-        temp := data[i];
-        sumofsquares := sumofsquares + Math.sqrr(temp);
-        sum := sum + temp
-    END
-END SumsAndSquares;
-
-
-(* Средниее значений массива *)
-PROCEDURE Mean* (data: ARRAY OF REAL; Count: INTEGER): REAL;
-    RETURN Sum(data, Count) / FLT(Count)
-END Mean;
-
-
-PROCEDURE MeanAndTotalVariance* (data: ARRAY OF REAL; Count: INTEGER;
-                                 VAR mu: REAL; VAR variance: REAL);
-VAR
-    i: INTEGER;
-
-BEGIN
-    mu := Mean(data, Count);
-    variance := 0.0;
-    FOR i := 0 TO Count - 1 DO
-        variance := variance + Math.sqrr(data[i] - mu)
-    END
-END MeanAndTotalVariance;
-
-
-(* Вычисление статистической дисперсии равной сумме квадратов разницы
-   между каждым конкретным значением массива Data и средним значением *)
-PROCEDURE TotalVariance* (data: ARRAY OF REAL; Count: INTEGER): REAL;
-VAR
-    mu, tv: REAL;
-
-BEGIN
-    MeanAndTotalVariance(data, Count, mu, tv)
-    RETURN tv
-END TotalVariance;
-
-
-(* Типовая дисперсия всех значений массива *)
-PROCEDURE Variance* (data: ARRAY OF REAL; Count: INTEGER): REAL;
-VAR
-    a: REAL;
-
-BEGIN
-    IF Count = 1 THEN
-        a := 0.0
-    ELSE
-        a := TotalVariance(data, Count) / FLT(Count - 1)
-    END
-
-    RETURN a
-END Variance;
-
-
-(* Стандартное среднеквадратичное отклонение *)
-PROCEDURE StdDev* (data: ARRAY OF REAL; Count: INTEGER): REAL;
-    RETURN Math.sqrt(Variance(data, Count))
-END StdDev;
-
-
-(* Среднее арифметическое всех значений массива, и среднее отклонение *)
-PROCEDURE MeanAndStdDev* (data: ARRAY OF REAL; Count: INTEGER;
-                            VAR mean: REAL; VAR stdDev: REAL);
-VAR
-    totalVariance: REAL;
-
-BEGIN
-    MeanAndTotalVariance(data, Count, mean, totalVariance);
-    IF Count < 2 THEN
-        stdDev := 0.0
-    ELSE
-        stdDev := Math.sqrt(totalVariance / FLT(Count - 1))
-    END
-END MeanAndStdDev;
-
-
-(* Евклидова норма для всех значений массива *)
-PROCEDURE Norm* (data: ARRAY OF REAL; Count: INTEGER): REAL;
-VAR
-    a: REAL;
-    i: INTEGER;
-
-BEGIN
-    a := 0.0;
-    FOR i := 0 TO Count - 1 DO
-        a := a + Math.sqrr(data[i])
-    END
-
-    RETURN Math.sqrt(a)
-END Norm;
-
-
-END MathStat.

programs/develop/oberon07/lib/Math/Rand.ob07

@@ -1,81 +0,0 @@
-(* ************************************
-   Генератор какбыслучайных чисел,
-   Линейный конгруэнтный метод,
-   алгоритм Лемера.
-   Вадим Исаев, 2020
-   -------------------------------
-   Generator pseudorandom numbers,
-   Linear congruential generator,
-   Algorithm by D. H. Lehmer.
-   Vadim Isaev, 2020
-*************************************** *)
-
-MODULE Rand;
-
-IMPORT HOST, Math;
-
-
-CONST
-
-    RAND_MAX = 2147483647;
-
-
-VAR
-    seed: INTEGER;
-
-
-PROCEDURE Randomize*;
-BEGIN
-    seed := HOST.GetTickCount()
-END Randomize;
-
-
-(* Целые какбыслучайные числа до RAND_MAX *)
-PROCEDURE RandomI* (): INTEGER;
-CONST
-    a = 630360016;
-
-BEGIN
-    seed := (a * seed) MOD RAND_MAX
-    RETURN seed
-END RandomI;
-
-
-(* Какбыслучайные числа с плавающей запятой от 0 до 1 *)
-PROCEDURE RandomR* (): REAL;
-    RETURN FLT(RandomI()) / FLT(RAND_MAX)
-END RandomR;
-
-
-(* Какбыслучайное число в диапазоне от 0 до l.
-   Return a random number in a range 0 ... l *)
-PROCEDURE RandomITo* (aTo: INTEGER): INTEGER;
-    RETURN FLOOR(RandomR() * FLT(aTo))
-END RandomITo;
-
-
-(* Какбыслучайное число в диапазоне.
-   Return a random number in a range *)
-PROCEDURE RandomIRange* (aFrom, aTo: INTEGER): INTEGER;
-    RETURN FLOOR(RandomR() * FLT(aTo - aFrom)) + aFrom
-END RandomIRange;
-
-
-(* Какбыслучайное число. Распределение Гаусса *)
-PROCEDURE RandG* (mean, stddev: REAL): REAL;
-VAR
-    U, S: REAL;
-
-BEGIN
-    REPEAT
-        U := 2.0 * RandomR() - 1.0;
-        S := Math.sqrr(U) + Math.sqrr(2.0 * RandomR() - 1.0)
-    UNTIL (1.0E-20 < S) & (S <= 1.0)
-
-    RETURN Math.sqrt(-2.0 * Math.ln(S) / S) * U * stddev + mean
-END RandG;
-
-
-BEGIN
-    seed := 654321
-END Rand.

programs/develop/oberon07/lib/Math/RandExt.ob07

@@ -1,298 +0,0 @@
-(* ************************************************************
-   Дополнительные алгоритмы генераторов какбыслучайных чисел.
-   Вадим Исаев, 2020
-
-   Additional generators of pseudorandom numbers.
-   Vadim Isaev, 2020
-   ************************************************************ *)
-
-MODULE RandExt;
-
-IMPORT HOST, MathRound, MathBits;
-
-CONST
-  (* Для алгоритма Мерсена-Твистера *)
-  N          = 624;
-  M          = 397;
-  MATRIX_A   = 9908B0DFH;  (* constant vector a *)
-  UPPER_MASK = 80000000H;  (* most significant w-r bits *)
-  LOWER_MASK = 7FFFFFFFH;  (* least significant r bits *)
-  INT_MAX    = 4294967295;
-
-
-TYPE
-(* структура служебных данных, для алгоритма mrg32k3a *)
-  random_t = RECORD
-    mrg32k3a_seed       : REAL;
-    mrg32k3a_x          : ARRAY 3 OF REAL;
-    mrg32k3a_y          : ARRAY 3 OF REAL
-  END;
-
-  (* Для алгоритма Мерсена-Твистера *)
-  MTKeyArray = ARRAY N OF INTEGER;
-
-VAR
-  (* Для алгоритма mrg32k3a *)
-  prndl: random_t;
-  (* Для алгоритма Мерсена-Твистера *)
-  mt  : MTKeyArray;  (* the array for the state vector *)
-  mti : INTEGER;     (* mti == N+1 means mt[N] is not initialized *)
-
-(* ---------------------------------------------------------------------------
-   Генератор какбыслучайных чисел в диапазоне [a,b].
-   Алгоритм 133б из книги "Агеев и др. - Бибилотека алгоритмов 101б-150б",
-   стр. 53.
-   Переделка из Algol на Oberon и доработка, Вадим Исаев, 2020
-
-   Generator pseudorandom numbers, algorithm 133b from
-   Comm ACM 5,10 (Oct 1962) 553.
-   Convert from Algol to Oberon Vadim Isaev, 2020.
-
-   Входные параметры:
-     a - начальное вычисляемое значение, тип REAL;
-     b - конечное вычисляемое значение, тип REAL;
-     seed - начальное значение для генерации случайного числа.
-            Должно быть в диапазоне от 10 000 000 000 до 34 359 738 368 (2^35),
-            нечётное.
-   --------------------------------------------------------------------------- *)
-PROCEDURE alg133b* (a, b: REAL; VAR seed: INTEGER): REAL;
-CONST
-  m35 = 34359738368;
-  m36 = 68719476736;
-  m37 = 137438953472;
-
-VAR
-  x: INTEGER;
-BEGIN
-  IF seed # 0 THEN
-    IF  (seed MOD 2 = 0) THEN
-      seed := seed + 1
-    END;
-    x:=seed;
-    seed:=0;
-  END;
-
-  x:=5*x;
-  IF x>=m37 THEN
-    x:=x-m37
-  END;
-  IF x>=m36 THEN
-    x:=x-m36
-  END;
-  IF x>=m35 THEN
-    x:=x-m35
-  END;
-
-  RETURN FLT(x) / FLT(m35) * (b - a) + a
-END alg133b;
-
-(* ----------------------------------------------------------
-   Генератор почти равномерно распределённых
-   какбыслучайных чисел mrg32k3a
-   (Combined Multiple Recursive Generator) от 0 до 1.
-   Период повторения последовательности = 2^127
-
-   Generator pseudorandom numbers,
-   algorithm mrg32k3a.
-
-   Переделка из FreePascal на Oberon, Вадим Исаев, 2020
-   Convert from FreePascal to Oberon, Vadim Isaev, 2020
-   ---------------------------------------------------------- *)
-(* Инициализация генератора.
-
-   Входные параметры:
-     seed  - значение для инициализации. Любое. Если передать
-             ноль, то вместо ноля будет подставлено кол-во
-             процессорных тиков. *)
-PROCEDURE mrg32k3a_init* (seed: REAL);
-BEGIN
-  prndl.mrg32k3a_x[0] := 1.0;
-  prndl.mrg32k3a_x[1] := 1.0;
-  prndl.mrg32k3a_y[0] := 1.0;
-  prndl.mrg32k3a_y[1] := 1.0;
-  prndl.mrg32k3a_y[2] := 1.0;
-
-  IF seed # 0.0 THEN
-    prndl.mrg32k3a_x[2] := seed;
-  ELSE
-    prndl.mrg32k3a_x[2] := FLT(HOST.GetTickCount());
-  END;
-
-END mrg32k3a_init;
-
-(* Генератор какбыслучайных чисел от 0.0 до 1.0. *)
-PROCEDURE mrg32k3a* (): REAL;
-
-CONST
-  (* random MRG32K3A algorithm constants *)
-  MRG32K3A_NORM = 2.328306549295728E-10;
-  MRG32K3A_M1   = 4294967087.0;
-  MRG32K3A_M2   = 4294944443.0;
-  MRG32K3A_A12  = 1403580.0;
-  MRG32K3A_A13  = 810728.0;
-  MRG32K3A_A21  = 527612.0;
-  MRG32K3A_A23  = 1370589.0;
-  RAND_BUFSIZE  = 512;
-
-VAR
-
-  xn, yn, result: REAL;
-
-BEGIN
-  (* Часть 1 *)
-  xn := MRG32K3A_A12 * prndl.mrg32k3a_x[1] - MRG32K3A_A13 * prndl.mrg32k3a_x[2];
-  xn := xn - MathRound.trunc(xn / MRG32K3A_M1) * MRG32K3A_M1;
-  IF xn < 0.0 THEN
-    xn := xn + MRG32K3A_M1;
-  END;
-
-  prndl.mrg32k3a_x[2] := prndl.mrg32k3a_x[1];
-  prndl.mrg32k3a_x[1] := prndl.mrg32k3a_x[0];
-  prndl.mrg32k3a_x[0] := xn;
-
-  (* Часть 2 *)
-  yn := MRG32K3A_A21 * prndl.mrg32k3a_y[0] - MRG32K3A_A23 * prndl.mrg32k3a_y[2];
-  yn := yn - MathRound.trunc(yn / MRG32K3A_M2) * MRG32K3A_M2;
-  IF yn < 0.0 THEN
-    yn := yn + MRG32K3A_M2;
-  END;
-
-  prndl.mrg32k3a_y[2] := prndl.mrg32k3a_y[1];
-  prndl.mrg32k3a_y[1] := prndl.mrg32k3a_y[0];
-  prndl.mrg32k3a_y[0] := yn;
-
-  (* Смешение частей *)
-  IF xn <= yn THEN
-    result := ((xn - yn + MRG32K3A_M1) * MRG32K3A_NORM)
-  ELSE
-    result := (xn - yn) * MRG32K3A_NORM;
-  END;
-
-  RETURN result
-END mrg32k3a;
-
-
-(* -------------------------------------------------------------------
-    Генератор какбыслучайных чисел, алгоритм Мерсена-Твистера (MT19937).
-    Переделка из Delphi в Oberon Вадим Исаев, 2020.
-
-    Mersenne Twister Random Number Generator.
-
-    A C-program for MT19937, with initialization improved 2002/1/26.
-    Coded by Takuji Nishimura and Makoto Matsumoto.
-
-    Adapted for DMath by Jean Debord - Feb. 2007
-    Adapted for Oberon-07 by Vadim Isaev - May 2020
-  ------------------------------------------------------------ *)
-(* Initializes MT generator with a seed *)
-PROCEDURE InitMT(Seed : INTEGER);
-VAR
-  i : INTEGER;
-BEGIN
-  mt[0] := MathBits.iand(Seed, INT_MAX);
-  FOR i := 1 TO N-1 DO
-      mt[i] := (1812433253 * MathBits.ixor(mt[i-1], LSR(mt[i-1], 30)) + i);
-        (* See Knuth TAOCP Vol2. 3rd Ed. P.106 For multiplier.
-          In the previous versions, MSBs of the seed affect
-          only MSBs of the array mt[].
-          2002/01/09 modified by Makoto Matsumoto *)
-      mt[i] := MathBits.iand(mt[i], INT_MAX);
-        (* For >32 Bit machines *)
-  END;
-  mti := N;
-END InitMT;
-
-(* Initialize MT generator with an array InitKey[0..(KeyLength - 1)] *)
-PROCEDURE InitMTbyArray(InitKey : MTKeyArray; KeyLength : INTEGER);
-VAR
-  i, j, k, k1 : INTEGER;
-BEGIN
-  InitMT(19650218);
-
-  i := 1;
-  j := 0;
-
-  IF N > KeyLength THEN
-    k1 := N
-  ELSE
-    k1 := KeyLength;
-  END;
-
-  FOR k := k1 TO 1 BY -1 DO
-    (* non linear *)
-    mt[i] := MathBits.ixor(mt[i], (MathBits.ixor(mt[i-1], LSR(mt[i-1], 30)) * 1664525)) + InitKey[j] + j;
-    mt[i] := MathBits.iand(mt[i], INT_MAX); (* for WORDSIZE > 32 machines *)
-    INC(i);
-    INC(j);
-    IF i >= N THEN
-      mt[0] := mt[N-1];
-      i := 1;
-    END;
-    IF j >= KeyLength THEN
-      j := 0;
-    END;
-  END;
-
-  FOR k := N-1 TO 1 BY -1 DO
-    (* non linear *)
-    mt[i] := MathBits.ixor(mt[i], (MathBits.ixor(mt[i-1], LSR(mt[i-1], 30)) * 1566083941)) - i;
-    mt[i] := MathBits.iand(mt[i], INT_MAX); (* for WORDSIZE > 32 machines *)
-    INC(i);
-    IF i >= N THEN
-      mt[0] := mt[N-1];
-      i := 1;
-    END;
-  END;
-
-  mt[0] := UPPER_MASK; (* MSB is 1; assuring non-zero initial array *)
-
-END InitMTbyArray;
-
-(* Generates a integer Random number on [-2^31 .. 2^31 - 1] interval *)
-PROCEDURE IRanMT(): INTEGER;
-VAR
-  mag01 : ARRAY 2 OF INTEGER;
-  y,k   : INTEGER;
-BEGIN
-  IF mti >= N THEN  (* generate N words at one Time *)
-    (* If IRanMT() has not been called, a default initial seed is used *)
-    IF mti = N + 1 THEN
-      InitMT(5489);
-    END;
-
-    FOR k := 0 TO (N-M)-1 DO
-      y := MathBits.ior(MathBits.iand(mt[k], UPPER_MASK), MathBits.iand(mt[k+1], LOWER_MASK));
-      mt[k] := MathBits.ixor(MathBits.ixor(mt[k+M], LSR(y, 1)), mag01[MathBits.iand(y, 1H)]);
-    END;
-
-    FOR k := (N-M) TO (N-2) DO
-      y := MathBits.ior(MathBits.iand(mt[k], UPPER_MASK), MathBits.iand(mt[k+1], LOWER_MASK));
-      mt[k] := MathBits.ixor(mt[k - (N - M)], MathBits.ixor(LSR(y, 1), mag01[MathBits.iand(y, 1H)]));
-    END;
-
-    y := MathBits.ior(MathBits.iand(mt[N-1], UPPER_MASK), MathBits.iand(mt[0], LOWER_MASK));
-    mt[N-1] := MathBits.ixor(mt[M-1], MathBits.ixor(LSR(y, 1), mag01[MathBits.iand(y, 1H)]));
-
-    mti := 0;
-  END;
-
-  y := mt[mti];
-  INC(mti);
-
-  (* Tempering *)
-  y := MathBits.ixor(y, LSR(y, 11));
-  y := MathBits.ixor(y, MathBits.iand(LSL(y,  7), 9D2C5680H));
-  y := MathBits.ixor(y, MathBits.iand(LSL(y, 15), 4022730752));
-  y := MathBits.ixor(y, LSR(y, 18));
-
-  RETURN y
-END IRanMT;
-
-(* Generates a real Random number on [0..1] interval *)
-PROCEDURE RRanMT(): REAL;
-BEGIN
-  RETURN FLT(IRanMT())/FLT(INT_MAX)
-END RRanMT;
-
-
-END RandExt.

programs/develop/oberon07/samples/BUILD_ALL.SH

@@ -1,5 +0,0 @@
-#SHS
-/kolibrios/develop/oberon07/compiler.kex HW.ob07 kosexe -out /tmp0/1/HW.kex -stk 1
-/kolibrios/develop/oberon07/compiler.kex HW_con.ob07 kosexe -out /tmp0/1/HW_con.kex -stk 1
-/kolibrios/develop/oberon07/compiler.kex Dialogs.ob07 kosexe -out /tmp0/1/Dialogs.kex -stk 1
-exit

programs/develop/oberon07/samples/Dialogs.ob07

@@ -1,159 +0,0 @@
-MODULE Dialogs;
-
-IMPORT
-	KOSAPI, SYSTEM, OpenDlg, ColorDlg;
-
-
-CONST
-	btnNone  =  0;
-	btnClose =  1;
-	btnOpen  = 17;
-	btnColor = 18;
-
-
-VAR
-	header: ARRAY 1024 OF CHAR;
-	back_color: INTEGER;
-
-
-PROCEDURE BeginDraw;
-BEGIN
-	KOSAPI.sysfunc2(12, 1)
-END BeginDraw;
-
-
-PROCEDURE EndDraw;
-BEGIN
-	KOSAPI.sysfunc2(12, 2)
-END EndDraw;
-
-
-PROCEDURE DefineAndDrawWindow (left, top, width, height, color, style, hcolor, hstyle: INTEGER; header: ARRAY OF CHAR);
-BEGIN
-	KOSAPI.sysfunc6(0, left*65536 + width, top*65536 + height, color + LSL(style, 24), hcolor + LSL(hstyle, 24), SYSTEM.ADR(header[0]))
-END DefineAndDrawWindow;
-
-
-PROCEDURE WaitForEvent (): INTEGER;
-	RETURN KOSAPI.sysfunc1(10)
-END WaitForEvent;
-
-
-PROCEDURE ExitApp;
-BEGIN
-	KOSAPI.sysfunc1(-1)
-END ExitApp;
-
-
-PROCEDURE pause (t: INTEGER);
-BEGIN
-	KOSAPI.sysfunc2(5, t)
-END pause;
-
-
-PROCEDURE Buttons;
-
-	PROCEDURE Button (id, X, Y, W, H: INTEGER; Caption: ARRAY OF CHAR);
-	VAR
-		n: INTEGER;
-	BEGIN
-		n := LENGTH(Caption);
-		KOSAPI.sysfunc5(8, X*65536 + W, Y*65536 + H, id, 00C0C0C0H);
-		X := X + (W - 8*n) DIV 2;
-		Y := Y + (H - 14) DIV 2;
-		KOSAPI.sysfunc6(4, X*65536 + Y, LSL(48, 24), SYSTEM.ADR(Caption[0]), n, 0)
-	END Button;
-
-BEGIN
-	Button(btnOpen,   5, 5, 70, 25, "open");
-	Button(btnColor, 85, 5, 70, 25, "color");
-END Buttons;
-
-
-PROCEDURE draw_window;
-BEGIN
-	BeginDraw;
-	DefineAndDrawWindow(200, 200, 500, 100, back_color, 51, 0, 0, header);
-	Buttons;
-	EndDraw;
-END draw_window;
-
-
-PROCEDURE OpenFile (Open: OpenDlg.Dialog);
-BEGIN
-	IF Open # NIL THEN
-		OpenDlg.Show(Open, 500, 450);
-		WHILE Open.status = 2 DO
-			pause(30)
-		END;
-		IF Open.status = 1 THEN
-			COPY(Open.FilePath, header)
-		END
-	END
-END OpenFile;
-
-
-PROCEDURE SelColor (Color: ColorDlg.Dialog);
-BEGIN
-	IF Color # NIL THEN
-		ColorDlg.Show(Color);
-		WHILE Color.status = 2 DO
-			pause(30)
-		END;
-		IF Color.status = 1 THEN
-			back_color := Color.color
-		END
-	END
-END SelColor;
-
-
-PROCEDURE GetButton (): INTEGER;
-VAR
-	btn: INTEGER;
-BEGIN
-	btn := KOSAPI.sysfunc1(17);
-	IF btn MOD 256 = 0 THEN
-		btn := btn DIV 256
-	ELSE
-		btn := btnNone
-	END
-	RETURN btn
-END GetButton;
-
-
-PROCEDURE main;
-CONST
-	EVENT_REDRAW = 1;
-	EVENT_KEY    = 2;
-	EVENT_BUTTON = 3;
-VAR
-	Open: OpenDlg.Dialog;
-	Color: ColorDlg.Dialog;
-BEGIN
-	back_color := 00FFFFFFH;
-	header := "Dialogs";
-	Open := OpenDlg.Create(draw_window, 0, "/sys", "ASM|TXT|INI");
-	Color := ColorDlg.Create(draw_window);
-
-	WHILE TRUE DO
-		CASE WaitForEvent() OF
-		|EVENT_REDRAW:
-			draw_window
-
-		|EVENT_KEY:
-
-		|EVENT_BUTTON:
-			CASE GetButton() OF
-			|btnNone:
-			|btnClose: ExitApp
-			|btnOpen:  OpenFile(Open)
-			|btnColor: SelColor(Color)
-			END
-		END
-	END
-END main;
-
-
-BEGIN
-	main
-END Dialogs.

programs/develop/oberon07/samples/HW.ob07

@@ -1,78 +0,0 @@
-MODULE HW;
-
-IMPORT
-	SYSTEM, KOSAPI;
-
-
-PROCEDURE BeginDraw;
-BEGIN
-	KOSAPI.sysfunc2(12, 1)
-END BeginDraw;
-
-
-PROCEDURE EndDraw;
-BEGIN
-	KOSAPI.sysfunc2(12, 2)
-END EndDraw;
-
-
-PROCEDURE DefineAndDrawWindow (left, top, width, height, color, style, hcolor, hstyle: INTEGER; header: ARRAY OF CHAR);
-BEGIN
-	KOSAPI.sysfunc6(0, left*65536 + width, top*65536 + height, color + LSL(style, 24), hcolor + LSL(hstyle, 24), SYSTEM.ADR(header[0]))
-END DefineAndDrawWindow;
-
-
-PROCEDURE WriteTextToWindow (x, y, color: INTEGER; text: ARRAY OF CHAR);
-BEGIN
-	KOSAPI.sysfunc6(4, x*65536 + y, color + LSL(48, 24), SYSTEM.ADR(text[0]), LENGTH(text), 0)
-END WriteTextToWindow;
-
-
-PROCEDURE WaitForEvent (): INTEGER;
-	RETURN KOSAPI.sysfunc1(10)
-END WaitForEvent;
-
-
-PROCEDURE ExitApp;
-BEGIN
-	KOSAPI.sysfunc1(-1)
-END ExitApp;
-
-
-PROCEDURE draw_window (header, text: ARRAY OF CHAR);
-CONST
-	WHITE = 0FFFFFFH;
-	RED   = 0C00000H;
-	GREEN = 0008000H;
-	BLUE  = 00000C0H;
-	GRAY  = 0808080H;
-BEGIN
-	BeginDraw;
-	DefineAndDrawWindow(200, 200, 300, 150, WHITE, 51, 0, 0, header);
-	WriteTextToWindow( 5, 10, RED,   text);
-	WriteTextToWindow(35, 30, GREEN, text);
-	WriteTextToWindow(65, 50, BLUE,  text);
-	WriteTextToWindow(95, 70, GRAY,  text);
-	EndDraw
-END draw_window;
-
-
-PROCEDURE main (header, text: ARRAY OF CHAR);
-CONST
-	EVENT_REDRAW = 1;
-	EVENT_KEY    = 2;
-	EVENT_BUTTON = 3;
-BEGIN
-	WHILE TRUE DO
-		CASE WaitForEvent() OF
-		|EVENT_REDRAW: draw_window(header, text)
-		|EVENT_KEY:    ExitApp
-		|EVENT_BUTTON: ExitApp
-		END
-	END
-END main;
-
-
-BEGIN
-	main("Hello", "Hello, world!")
-END HW.

programs/develop/oberon07/samples/HW_con.ob07

@@ -1,59 +0,0 @@
-MODULE HW_con;
-
-IMPORT
-	Out, In, Console, DateTime;
-
-
-PROCEDURE OutInt2 (n: INTEGER);
-BEGIN
-	ASSERT((0 <= n) & (n <= 99));
-	IF n < 10 THEN
-		Out.Char("0")
-	END;
-	Out.Int(n, 0)
-END OutInt2;
-
-
-PROCEDURE OutMonth (n: INTEGER);
-VAR
-	str: ARRAY 4 OF CHAR;
-BEGIN
-	CASE n OF
-	| 1: str := "jan"
-	| 2: str := "feb"
-	| 3: str := "mar"
-	| 4: str := "apr"
-	| 5: str := "may"
-	| 6: str := "jun"
-	| 7: str := "jul"
-	| 8: str := "aug"
-	| 9: str := "sep"
-	|10: str := "oct"
-	|11: str := "nov"
-	|12: str := "dec"
-	END;
-	Out.String(str)
-END OutMonth;
-
-
-PROCEDURE main;
-VAR
-	Year, Month, Day,
-	Hour, Min, Sec, Msec: INTEGER;
-BEGIN
-	Out.String("Hello, world!"); Out.Ln;
-	Console.SetColor(Console.White, Console.Red);
-	DateTime.Now(Year, Month, Day, Hour, Min, Sec, Msec);
-	OutInt2(Day); Out.Char("-"); OutMonth(Month); Out.Char("-"); Out.Int(Year, 0); Out.Char(" ");
-	OutInt2(Hour); Out.Char(":"); OutInt2(Min); Out.Char(":"); OutInt2(Sec); Out.Ln;
-	Console.SetColor(Console.Blue, Console.LightGray);
-	Out.Ln; Out.String("press enter...");
-	In.Ln
-END main;
-
-
-BEGIN
-	Console.open;
-	main;
-	Console.exit(TRUE)
-END HW_con.

programs/develop/oberon07/source/ARITH.ob07

@@ -1,797 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2022, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE ARITH;
-
-IMPORT STRINGS, UTILS, LISTS;
-
-
-CONST
-
-    tINTEGER* = 1;  tREAL* = 2;  tSET*    = 3;
-    tBOOLEAN* = 4;  tCHAR* = 5;  tWCHAR*  = 6;
-    tSTRING*  = 7;
-
-    opEQ* = 0; opNE* = 1; opLT* = 2; opLE* = 3; opGT* = 4; opGE* = 5;
-    opIN* = 6; opIS* = 7;
-
-
-TYPE
-
-    VALUE* = RECORD
-
-        typ*:      INTEGER;
-
-        int:       INTEGER;
-        float:     REAL;
-        set:       SET;
-        bool:      BOOLEAN;
-
-        string*:   LISTS.ITEM
-
-    END;
-
-
-VAR
-
-    digit: ARRAY 256 OF INTEGER;
-
-
-PROCEDURE Int* (v: VALUE): INTEGER;
-VAR
-    res: INTEGER;
-
-BEGIN
-
-    CASE v.typ OF
-    |tINTEGER, tCHAR, tWCHAR:
-        res := v.int
-    |tSET:
-        res := UTILS.Long(ORD(v.set))
-    |tBOOLEAN:
-        res := ORD(v.bool)
-    END
-
-    RETURN res
-END Int;
-
-
-PROCEDURE getBool* (v: VALUE): BOOLEAN;
-BEGIN
-    ASSERT(v.typ = tBOOLEAN);
-
-    RETURN v.bool
-END getBool;
-
-
-PROCEDURE Float* (v: VALUE): REAL;
-BEGIN
-    ASSERT(v.typ = tREAL);
-
-    RETURN v.float
-END Float;
-
-
-PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN;
-    RETURN (a <= i.int) & (i.int <= b)
-END range;
-
-
-PROCEDURE check* (v: VALUE): BOOLEAN;
-VAR
-    res: BOOLEAN;
-
-BEGIN
-    CASE v.typ OF
-    |tINTEGER: res := range(v, UTILS.target.minInt, UTILS.target.maxInt)
-    |tCHAR:    res := range(v, 0, 255)
-    |tWCHAR:   res := range(v, 0, 65535)
-    |tREAL:    res := (-UTILS.target.maxReal <= v.float) & (v.float <= UTILS.target.maxReal)
-    END
-
-    RETURN res
-END check;
-
-
-PROCEDURE isZero* (v: VALUE): BOOLEAN;
-VAR
-    res: BOOLEAN;
-
-BEGIN
-    CASE v.typ OF
-    |tINTEGER: res := v.int = 0
-    |tREAL:    res := v.float = 0.0
-    END
-
-    RETURN res
-END isZero;
-
-
-PROCEDURE iconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
-VAR
-    value: INTEGER;
-    i:     INTEGER;
-    d:     INTEGER;
-
-BEGIN
-    error := 0;
-    value := 0;
-
-    i := 0;
-    WHILE STRINGS.digit(s[i]) & (error = 0) DO
-        d := digit[ORD(s[i])];
-        IF value <= (UTILS.maxint - d) DIV 10 THEN
-            value := value * 10 + d;
-            INC(i)
-        ELSE
-            error := 1
-        END
-    END;
-
-    IF error = 0 THEN
-        v.int := value;
-        v.typ := tINTEGER;
-        IF ~check(v) THEN
-            error := 1
-        END
-    END
-
-END iconv;
-
-
-PROCEDURE hconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
-VAR
-    value: INTEGER;
-    i:     INTEGER;
-    n:     INTEGER;
-    d:     INTEGER;
-
-BEGIN
-    ASSERT(STRINGS.digit(s[0]));
-
-    error := 0;
-    value := 0;
-
-    n := -1;
-    i := 0;
-    WHILE (s[i] # "H") & (s[i] # "X") & (s[i] # "h") & (s[i] # "x") & (error = 0) DO
-
-        d := digit[ORD(s[i])];
-        IF (n = -1) & (d # 0) THEN
-            n := i
-        END;
-
-        IF (n # -1) & (i - n + 1 > UTILS.target.maxHex) THEN
-            error := 2
-        ELSE
-            value := value * 16 + d;
-            INC(i)
-        END
-
-    END;
-
-    value := UTILS.Long(value);
-
-    IF ((s[i] = "X") OR (s[i] = "x")) & (n # -1) & (i - n > 4) THEN
-        error := 3
-    END;
-
-    IF error = 0 THEN
-        v.int := value;
-        IF (s[i] = "X") OR (s[i] = "x") THEN
-            v.typ := tCHAR;
-            IF ~check(v) THEN
-                v.typ := tWCHAR;
-                IF ~check(v) THEN
-                    error := 3
-                END
-            END
-        ELSE
-            v.typ := tINTEGER;
-            IF ~check(v) THEN
-                error := 2
-            END
-        END
-    END
-
-END hconv;
-
-
-PROCEDURE opFloat2 (VAR a: REAL; b: REAL; op: CHAR): BOOLEAN;
-BEGIN
-    CASE op OF
-    |"+": a := a + b
-    |"-": a := a - b
-    |"*": a := a * b
-    |"/": a := a / b
-    END
-
-    RETURN (-UTILS.maxreal <= a) & (a <= UTILS.maxreal) (* +inf > UTILS.maxreal *)
-END opFloat2;
-
-
-PROCEDURE fconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
-VAR
-    value:    REAL;
-    exp10:    REAL;
-    i, n, d:  INTEGER;
-    minus:    BOOLEAN;
-
-BEGIN
-    error := 0;
-    value := 0.0;
-    minus := FALSE;
-    n := 0;
-
-    exp10 := 0.0;
-    WHILE (error = 0) & (STRINGS.digit(s[i]) OR (s[i] = ".")) DO
-        IF s[i] = "." THEN
-            exp10 := 1.0;
-            INC(i)
-        ELSE
-            IF opFloat2(value, 10.0, "*") & opFloat2(value, FLT(digit[ORD(s[i])]), "+") & opFloat2(exp10, 10.0, "*") THEN
-                INC(i)
-            ELSE
-                error := 4
-            END
-        END
-    END;
-
-    IF ~opFloat2(value, exp10, "/") THEN
-        error := 4
-    END;
-
-    IF (s[i] = "E") OR (s[i] = "e") THEN
-        INC(i)
-    END;
-
-    IF (s[i] = "-") OR (s[i] = "+") THEN
-        minus := s[i] = "-";
-        INC(i)
-    END;
-
-    WHILE (error = 0) & STRINGS.digit(s[i]) DO
-        d := digit[ORD(s[i])];
-        IF n <= (UTILS.maxint - d) DIV 10 THEN
-            n := n * 10 + d;
-            INC(i)
-        ELSE
-            error := 5
-        END
-    END;
-
-    exp10 := 1.0;
-    WHILE (error = 0) & (n > 0) DO
-        IF opFloat2(exp10, 10.0, "*") THEN
-            DEC(n)
-        ELSE
-            error := 4
-        END
-    END;
-
-    IF error = 0 THEN
-        IF minus THEN
-            IF ~opFloat2(value, exp10, "/") THEN
-                error := 4
-            END
-        ELSE
-            IF ~opFloat2(value, exp10, "*") THEN
-                error := 4
-            END
-        END
-    END;
-
-    IF error = 0 THEN
-        v.float := value;
-        v.typ := tREAL;
-        IF ~check(v) THEN
-            error := 4
-        END
-    END
-
-END fconv;
-
-
-PROCEDURE setChar* (VAR v: VALUE; ord: INTEGER);
-BEGIN
-    v.typ := tCHAR;
-    v.int := ord
-END setChar;
-
-
-PROCEDURE setWChar* (VAR v: VALUE; ord: INTEGER);
-BEGIN
-    v.typ := tWCHAR;
-    v.int := ord
-END setWChar;
-
-
-PROCEDURE addInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;
-VAR
-    error: BOOLEAN;
-
-BEGIN
-    IF (a > 0) & (b > 0) THEN
-        error := a > UTILS.maxint - b
-    ELSIF (a < 0) & (b < 0) THEN
-        error := a < UTILS.minint - b
-    ELSE
-        error := FALSE
-    END;
-
-    IF ~error THEN
-        a := a + b
-    ELSE
-        a := 0
-    END
-
-    RETURN ~error
-END addInt;
-
-
-PROCEDURE subInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;
-VAR
-    error: BOOLEAN;
-
-BEGIN
-    IF (a > 0) & (b < 0) THEN
-        error := a > UTILS.maxint + b
-    ELSIF (a < 0) & (b > 0) THEN
-        error := a < UTILS.minint + b
-    ELSIF (a = 0) & (b < 0) THEN
-        error := b = UTILS.minint
-    ELSE
-        error := FALSE
-    END;
-
-    IF ~error THEN
-        a := a - b
-    ELSE
-        a := 0
-    END
-
-    RETURN ~error
-END subInt;
-
-
-PROCEDURE lg2 (x: INTEGER): INTEGER;
-VAR
-    n: INTEGER;
-
-BEGIN
-    ASSERT(x > 0);
-
-    n := UTILS.Log2(x);
-    IF n = -1 THEN
-        n := 255
-    END
-
-    RETURN n
-END lg2;
-
-
-PROCEDURE mulInt* (VAR a: INTEGER; b: INTEGER): BOOLEAN;
-VAR
-    error:    BOOLEAN;
-    min, max: INTEGER;
-
-BEGIN
-    min := UTILS.minint;
-    max := UTILS.maxint;
-
-    IF ((a > 1) & (b > 1)) OR ((a < 0) & (b < 0)) THEN
-        error := (a = min) OR (b = min) OR (ABS(a) > max DIV ABS(b))
-
-    ELSIF ((a > 1) & (b < 0)) OR ((a < 0) & (b > 1)) THEN
-        error := (a = min) OR (b = min);
-        IF ~error THEN
-            IF lg2(ABS(a)) + lg2(ABS(b)) >= UTILS.bit_depth THEN
-                error := ABS(a) > max DIV ABS(b)
-            END
-        END
-
-    ELSE
-        error := FALSE
-    END;
-
-    IF ~error THEN
-        a := a * b
-    ELSE
-        a := 0
-    END
-
-    RETURN ~error
-END mulInt;
-
-
-PROCEDURE _ASR (x, n: INTEGER): INTEGER;
-    RETURN ASR(UTILS.Long(x), n)
-END _ASR;
-
-
-PROCEDURE _LSR (x, n: INTEGER): INTEGER;
-    RETURN UTILS.Long(LSR(UTILS.Short(x), n))
-END _LSR;
-
-
-PROCEDURE _LSL (x, n: INTEGER): INTEGER;
-    RETURN UTILS.Long(LSL(x, n))
-END _LSL;
-
-
-PROCEDURE _ROR1_32 (x: INTEGER): INTEGER;
-BEGIN
-    x := UTILS.Short(x);
-    x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31)))
-    RETURN UTILS.Long(x)
-END _ROR1_32;
-
-
-PROCEDURE _ROR1_16 (x: INTEGER): INTEGER;
-BEGIN
-    x := x MOD 65536;
-    x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 15)))
-    RETURN UTILS.Long(x)
-END _ROR1_16;
-
-
-PROCEDURE _ROR (x, n: INTEGER): INTEGER;
-BEGIN
-
-    CASE UTILS.bit_diff OF
-    |0: x := ROR(x, n)
-    |16, 48:
-        n := n MOD 16;
-        WHILE n > 0 DO
-            x := _ROR1_16(x);
-            DEC(n)
-        END
-    |32:
-        n := n MOD 32;
-        WHILE n > 0 DO
-            x := _ROR1_32(x);
-            DEC(n)
-        END
-    END
-
-    RETURN x
-END _ROR;
-
-
-PROCEDURE opInt* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN;
-VAR
-    success: BOOLEAN;
-
-BEGIN
-    success := TRUE;
-
-    CASE op OF
-    |"+": success := addInt(a.int, b.int)
-    |"-": success := subInt(a.int, b.int)
-    |"*": success := mulInt(a.int, b.int)
-    |"/": success := FALSE
-    |"D": a.int := a.int DIV b.int
-    |"M": a.int := a.int MOD b.int
-    |"L": a.int := _LSL(a.int, b.int)
-    |"A": a.int := _ASR(a.int, b.int)
-    |"O": a.int := _ROR(a.int, b.int)
-    |"R": a.int := _LSR(a.int, b.int)
-    |"m": a.int := MIN(a.int, b.int)
-    |"x": a.int := MAX(a.int, b.int)
-    END;
-    a.typ := tINTEGER
-
-    RETURN success & check(a)
-END opInt;
-
-
-PROCEDURE charToStr* (c: VALUE; VAR s: ARRAY OF CHAR);
-BEGIN
-    s[0] := CHR(c.int);
-    s[1] := 0X
-END charToStr;
-
-
-PROCEDURE opSet* (VAR a: VALUE; b: VALUE; op: CHAR);
-BEGIN
-    CASE op OF
-    |"+": a.set := a.set + b.set
-    |"-": a.set := a.set - b.set
-    |"*": a.set := a.set * b.set
-    |"/": a.set := a.set / b.set
-    END;
-    a.typ := tSET
-END opSet;
-
-
-PROCEDURE opFloat* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN;
-BEGIN
-    a.typ := tREAL
-    RETURN opFloat2(a.float, b.float, op) & check(a)
-END opFloat;
-
-
-PROCEDURE ord* (VAR v: VALUE);
-BEGIN
-    CASE v.typ OF
-    |tCHAR, tWCHAR:
-    |tBOOLEAN: v.int := ORD(v.bool)
-    |tSET:     v.int := UTILS.Long(ORD(v.set))
-    END;
-    v.typ := tINTEGER
-END ord;
-
-
-PROCEDURE odd* (VAR v: VALUE);
-BEGIN
-    v.typ := tBOOLEAN;
-    v.bool := ODD(v.int)
-END odd;
-
-
-PROCEDURE bits* (VAR v: VALUE);
-BEGIN
-    v.typ := tSET;
-    v.set := BITS(v.int)
-END bits;
-
-
-PROCEDURE abs* (VAR v: VALUE): BOOLEAN;
-VAR
-    res: BOOLEAN;
-
-BEGIN
-    res := FALSE;
-
-    CASE v.typ OF
-    |tREAL:
-        v.float := ABS(v.float);
-        res := TRUE
-    |tINTEGER:
-        IF v.int # UTILS.minint THEN
-            v.int := ABS(v.int);
-            res := TRUE
-        END
-    END
-
-    RETURN res
-END abs;
-
-
-PROCEDURE floor* (VAR v: VALUE): BOOLEAN;
-VAR
-    res: BOOLEAN;
-
-BEGIN
-    v.typ := tINTEGER;
-    res := (FLT(UTILS.minint) <= v.float) & (v.float <= FLT(UTILS.maxint));
-    IF res THEN
-        v.int := FLOOR(v.float)
-    END
-
-    RETURN res
-END floor;
-
-
-PROCEDURE flt* (VAR v: VALUE);
-BEGIN
-    v.typ := tREAL;
-    v.float := FLT(v.int)
-END flt;
-
-
-PROCEDURE neg* (VAR v: VALUE): BOOLEAN;
-VAR
-    z: VALUE;
-    res: BOOLEAN;
-
-BEGIN
-    res := TRUE;
-
-    z.typ := tINTEGER;
-    z.int := 0;
-
-    CASE v.typ OF
-    |tREAL:     v.float := -v.float
-    |tSET:      v.set := -v.set
-    |tINTEGER:  res := opInt(z, v, "-"); v := z
-    |tBOOLEAN:  v.bool := ~v.bool
-    END
-
-    RETURN res
-END neg;
-
-
-PROCEDURE setbool* (VAR v: VALUE; b: BOOLEAN);
-BEGIN
-    v.bool := b;
-    v.typ := tBOOLEAN
-END setbool;
-
-
-PROCEDURE opBoolean* (VAR a: VALUE; b: VALUE; op: CHAR);
-BEGIN
-    CASE op OF
-    |"&": a.bool := a.bool & b.bool
-    |"|": a.bool := a.bool OR b.bool
-    END;
-    a.typ := tBOOLEAN
-END opBoolean;
-
-
-PROCEDURE less (v, v2: VALUE; VAR error: INTEGER): BOOLEAN;
-VAR
-    res: BOOLEAN;
-
-BEGIN
-    res := FALSE;
-
-    IF (v.typ = v2.typ) OR (v.typ IN {tCHAR, tWCHAR}) & (v2.typ IN {tCHAR, tWCHAR}) THEN
-        CASE v.typ OF
-        |tINTEGER,
-         tWCHAR,
-         tCHAR:     res := v.int < v2.int
-        |tREAL:     res := v.float < v2.float
-        |tBOOLEAN,
-         tSET:      error := 1
-        END
-    ELSE
-        error := 1
-    END
-
-    RETURN res
-END less;
-
-
-PROCEDURE equal (v, v2: VALUE; VAR error: INTEGER): BOOLEAN;
-VAR
-    res: BOOLEAN;
-
-BEGIN
-    res := FALSE;
-
-    IF (v.typ = v2.typ) OR (v.typ IN {tCHAR, tWCHAR}) & (v2.typ IN {tCHAR, tWCHAR}) THEN
-        CASE v.typ OF
-        |tINTEGER,
-         tWCHAR,
-         tCHAR:     res := v.int = v2.int
-        |tREAL:     res := v.float = v2.float
-        |tBOOLEAN:  res := v.bool = v2.bool
-        |tSET:      res := v.set = v2.set
-        END
-    ELSE
-        error := 1
-    END
-
-    RETURN res
-END equal;
-
-
-PROCEDURE relation* (VAR v: VALUE; v2: VALUE; op: INTEGER; VAR error: INTEGER);
-VAR
-    res: BOOLEAN;
-
-BEGIN
-    error := 0;
-
-    res := FALSE;
-
-    CASE op OF
-
-    |opEQ:
-        res := equal(v, v2, error)
-
-    |opNE:
-        res := ~equal(v, v2, error)
-
-    |opLT:
-        res := less(v, v2, error)
-
-    |opLE:
-        res := less(v, v2, error);
-        IF error = 0 THEN
-            res := equal(v, v2, error) OR res
-        END
-
-    |opGE:
-        res := ~less(v, v2, error)
-
-    |opGT:
-        res := less(v, v2, error);
-        IF error = 0 THEN
-            res := equal(v, v2, error) OR res
-        END;
-        res := ~res
-
-    |opIN:
-        IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN
-            IF range(v, 0, UTILS.target.maxSet) THEN
-                res := v.int IN v2.set
-            ELSE
-                error := 2
-            END
-        ELSE
-            error := 1
-        END
-
-    END;
-
-    IF error = 0 THEN
-        v.bool := res;
-        v.typ  := tBOOLEAN
-    END
-
-END relation;
-
-
-PROCEDURE emptySet* (VAR v: VALUE);
-BEGIN
-    v.typ := tSET;
-    v.set := {}
-END emptySet;
-
-
-PROCEDURE constrSet* (VAR v: VALUE; a, b: VALUE);
-BEGIN
-    v.typ := tSET;
-    v.set := {a.int .. b.int}
-END constrSet;
-
-
-PROCEDURE getInt* (v: VALUE): INTEGER;
-BEGIN
-    ASSERT(check(v))
-
-    RETURN v.int
-END getInt;
-
-
-PROCEDURE setInt* (VAR v: VALUE; i: INTEGER): BOOLEAN;
-BEGIN
-    v.int := i;
-    v.typ := tINTEGER
-
-    RETURN check(v)
-END setInt;
-
-
-PROCEDURE concat* (VAR s: ARRAY OF CHAR; s1: ARRAY OF CHAR): BOOLEAN;
-VAR
-    res: BOOLEAN;
-
-BEGIN
-    res := LENGTH(s) + LENGTH(s1) < LEN(s);
-    IF res THEN
-        STRINGS.append(s, s1)
-    END
-
-    RETURN res
-END concat;
-
-
-PROCEDURE init;
-VAR
-    i: INTEGER;
-
-BEGIN
-    FOR i := 0 TO LEN(digit) - 1 DO
-        digit[i] := -1
-    END;
-
-    FOR i := ORD("0") TO ORD("9") DO
-        digit[i] := i - ORD("0")
-    END;
-
-    FOR i := ORD("A") TO ORD("F") DO
-        digit[i] := i - ORD("A") + 10
-    END
-END init;
-
-
-BEGIN
-    init
-END ARITH.

programs/develop/oberon07/source/AVLTREES.ob07

@@ -1,197 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2019, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE AVLTREES;
-
-IMPORT C := COLLECTIONS;
-
-
-TYPE
-
-    DATA* = POINTER TO RECORD (C.ITEM) END;
-
-    NODE* = POINTER TO RECORD (C.ITEM)
-
-        data*: DATA;
-
-        height: INTEGER;
-
-        left*, right*: NODE
-
-    END;
-
-    CMP* = PROCEDURE (a, b: DATA): INTEGER;
-
-    DESTRUCTOR* = PROCEDURE (VAR data: DATA);
-
-
-VAR
-
-    nodes: C.COLLECTION;
-
-
-PROCEDURE NewNode (data: DATA): NODE;
-VAR
-    node:  NODE;
-    citem: C.ITEM;
-
-BEGIN
-    citem := C.pop(nodes);
-    IF citem = NIL THEN
-        NEW(node)
-    ELSE
-        node := citem(NODE)
-    END;
-
-    node.data := data;
-    node.left := NIL;
-    node.right := NIL;
-    node.height := 1
-
-    RETURN node
-END NewNode;
-
-
-PROCEDURE height (p: NODE): INTEGER;
-VAR
-    res: INTEGER;
-
-BEGIN
-    IF p = NIL THEN
-        res := 0
-    ELSE
-        res := p.height
-    END
-
-    RETURN res
-END height;
-
-
-PROCEDURE bfactor (p: NODE): INTEGER;
-    RETURN height(p.right) - height(p.left)
-END bfactor;
-
-
-PROCEDURE fixheight (p: NODE);
-BEGIN
-    p.height := MAX(height(p.left), height(p.right)) + 1
-END fixheight;
-
-
-PROCEDURE rotateright (p: NODE): NODE;
-VAR
-    q: NODE;
-
-BEGIN
-    q := p.left;
-    p.left := q.right;
-    q.right := p;
-    fixheight(p);
-    fixheight(q)
-
-    RETURN q
-END rotateright;
-
-
-PROCEDURE rotateleft (q: NODE): NODE;
-VAR
-    p: NODE;
-
-BEGIN
-    p := q.right;
-    q.right := p.left;
-    p.left := q;
-    fixheight(q);
-    fixheight(p)
-
-    RETURN p
-END rotateleft;
-
-
-PROCEDURE balance (p: NODE): NODE;
-VAR
-    res: NODE;
-
-BEGIN
-    fixheight(p);
-
-    IF bfactor(p) = 2 THEN
-        IF bfactor(p.right) < 0 THEN
-            p.right := rotateright(p.right)
-        END;
-        res := rotateleft(p)
-
-    ELSIF bfactor(p) = -2 THEN
-        IF bfactor(p.left) > 0 THEN
-            p.left := rotateleft(p.left)
-        END;
-        res := rotateright(p)
-
-    ELSE
-        res := p
-    END
-
-    RETURN res
-END balance;
-
-
-PROCEDURE insert* (p: NODE; data: DATA; cmp: CMP; VAR newnode: BOOLEAN; VAR node: NODE): NODE;
-VAR
-    res: NODE;
-    rescmp: INTEGER;
-
-BEGIN
-    IF p = NIL THEN
-        res := NewNode(data);
-        node := res;
-        newnode := TRUE
-    ELSE
-
-        rescmp := cmp(data, p.data);
-        IF rescmp < 0 THEN
-            p.left := insert(p.left, data, cmp, newnode, node);
-            res := balance(p)
-        ELSIF rescmp > 0 THEN
-            p.right := insert(p.right, data, cmp, newnode, node);
-            res := balance(p)
-        ELSE
-            res := p;
-            node := res;
-            newnode := FALSE
-        END
-
-    END
-
-    RETURN res
-END insert;
-
-
-PROCEDURE destroy* (VAR node: NODE; destructor: DESTRUCTOR);
-VAR
-    left, right: NODE;
-
-BEGIN
-    IF node # NIL THEN
-        left  := node.left;
-        right := node.right;
-
-        IF destructor # NIL THEN
-            destructor(node.data)
-        END;
-
-        C.push(nodes, node);
-        node := NIL;
-
-        destroy(left, destructor);
-        destroy(right, destructor)
-    END
-END destroy;
-
-
-BEGIN
-    nodes := C.create()
-END AVLTREES.

programs/develop/oberon07/source/BIN.ob07

@@ -1,384 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2020, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE BIN;
-
-IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS;
-
-
-CONST
-
-    RCODE*  = 0;  PICCODE* = RCODE + 1;
-    RDATA*  = 2;  PICDATA* = RDATA + 1;
-    RBSS*   = 4;  PICBSS*  = RBSS + 1;
-    RIMP*   = 6;  PICIMP*  = RIMP + 1;
-
-    IMPTAB* = 8;
-
-
-TYPE
-
-    RELOC* = POINTER TO RECORD (LISTS.ITEM)
-
-        opcode*: INTEGER;
-        offset*: INTEGER
-
-    END;
-
-    IMPRT* = POINTER TO RECORD (LISTS.ITEM)
-
-        nameoffs*: INTEGER;
-        label*:    INTEGER;
-
-        OriginalFirstThunk*,
-        FirstThunk*: INTEGER
-
-    END;
-
-    EXPRT* = POINTER TO RECORD (LISTS.ITEM)
-
-        nameoffs*: INTEGER;
-        label*:    INTEGER
-
-    END;
-
-    PROGRAM* = POINTER TO RECORD
-
-        code*:      CHL.BYTELIST;
-        data*:      CHL.BYTELIST;
-        labels:     CHL.INTLIST;
-        bss*:       INTEGER;
-        stack*:     INTEGER;
-        vmajor*,
-        vminor*:    WCHAR;
-        modname*:   INTEGER;
-        _import*:   CHL.BYTELIST;
-        export*:    CHL.BYTELIST;
-        rel_list*:  LISTS.LIST;
-        imp_list*:  LISTS.LIST;
-        exp_list*:  LISTS.LIST
-
-    END;
-
-
-PROCEDURE create* (NumberOfLabels: INTEGER): PROGRAM;
-VAR
-    program:  PROGRAM;
-    i:        INTEGER;
-
-BEGIN
-    NEW(program);
-
-    program.bss := 0;
-
-    program.labels := CHL.CreateIntList();
-    FOR i := 0 TO NumberOfLabels - 1 DO
-        CHL.PushInt(program.labels, 0)
-    END;
-
-    program.rel_list := LISTS.create(NIL);
-    program.imp_list := LISTS.create(NIL);
-    program.exp_list := LISTS.create(NIL);
-
-    program.data    := CHL.CreateByteList();
-    program.code    := CHL.CreateByteList();
-    program._import := CHL.CreateByteList();
-    program.export  := CHL.CreateByteList()
-
-    RETURN program
-END create;
-
-
-PROCEDURE SetParams* (program: PROGRAM; bss, stack: INTEGER; vmajor, vminor: WCHAR);
-BEGIN
-    program.bss    := bss;
-    program.stack  := stack;
-    program.vmajor := vmajor;
-    program.vminor := vminor
-END SetParams;
-
-
-PROCEDURE PutReloc* (program: PROGRAM; opcode: INTEGER);
-VAR
-    cmd: RELOC;
-
-BEGIN
-    NEW(cmd);
-    cmd.opcode := opcode;
-    cmd.offset := CHL.Length(program.code);
-    LISTS.push(program.rel_list, cmd)
-END PutReloc;
-
-
-PROCEDURE PutData* (program: PROGRAM; b: BYTE);
-BEGIN
-    CHL.PushByte(program.data, b)
-END PutData;
-
-
-PROCEDURE get32le* (_array: CHL.BYTELIST; idx: INTEGER): INTEGER;
-VAR
-    i: INTEGER;
-    x: INTEGER;
-
-BEGIN
-    x := 0;
-
-    FOR i := 3 TO 0 BY -1 DO
-        x := LSL(x, 8) + CHL.GetByte(_array, idx + i)
-    END;
-
-    IF UTILS.bit_depth = 64 THEN
-        x := LSL(x, 16);
-        x := LSL(x, 16);
-        x := ASR(x, 16);
-        x := ASR(x, 16)
-    END
-
-    RETURN x
-END get32le;
-
-
-PROCEDURE put32le* (_array: CHL.BYTELIST; idx: INTEGER; x: INTEGER);
-VAR
-    i: INTEGER;
-
-BEGIN
-    FOR i := 0 TO 3 DO
-        CHL.SetByte(_array, idx + i, UTILS.Byte(x, i))
-    END
-END put32le;
-
-
-PROCEDURE PutData32LE* (program: PROGRAM; x: INTEGER);
-VAR
-    i: INTEGER;
-
-BEGIN
-    FOR i := 0 TO 3 DO
-        CHL.PushByte(program.data, UTILS.Byte(x, i))
-    END
-END PutData32LE;
-
-
-PROCEDURE PutData64LE* (program: PROGRAM; x: INTEGER);
-VAR
-    i: INTEGER;
-
-BEGIN
-    FOR i := 0 TO 7 DO
-        CHL.PushByte(program.data, UTILS.Byte(x, i))
-    END
-END PutData64LE;
-
-
-PROCEDURE PutDataStr* (program: PROGRAM; s: ARRAY OF CHAR);
-VAR
-    i: INTEGER;
-
-BEGIN
-    i := 0;
-    WHILE s[i] # 0X DO
-        PutData(program, ORD(s[i]));
-        INC(i)
-    END
-END PutDataStr;
-
-
-PROCEDURE PutCode* (program: PROGRAM; b: BYTE);
-BEGIN
-    CHL.PushByte(program.code, b)
-END PutCode;
-
-
-PROCEDURE PutCode32LE* (program: PROGRAM; x: INTEGER);
-VAR
-    i: INTEGER;
-
-BEGIN
-    FOR i := 0 TO 3 DO
-        CHL.PushByte(program.code, UTILS.Byte(x, i))
-    END
-END PutCode32LE;
-
-
-PROCEDURE PutCode16LE* (program: PROGRAM; x: INTEGER);
-BEGIN
-    CHL.PushByte(program.code, UTILS.Byte(x, 0));
-    CHL.PushByte(program.code, UTILS.Byte(x, 1))
-END PutCode16LE;
-
-
-PROCEDURE SetLabel* (program: PROGRAM; label, offset: INTEGER);
-BEGIN
-    CHL.SetInt(program.labels, label, offset)
-END SetLabel;
-
-
-PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
-VAR
-    imp: IMPRT;
-
-BEGIN
-    CHL.PushByte(program._import, 0);
-    CHL.PushByte(program._import, 0);
-
-    IF ODD(CHL.Length(program._import)) THEN
-        CHL.PushByte(program._import, 0)
-    END;
-
-    NEW(imp);
-    imp.nameoffs := CHL.PushStr(program._import, name);
-    imp.label := label;
-    LISTS.push(program.imp_list, imp)
-END Import;
-
-
-PROCEDURE less (bytes: CHL.BYTELIST; a, b: EXPRT): BOOLEAN;
-VAR
-    i, j: INTEGER;
-
-BEGIN
-    i := a.nameoffs;
-    j := b.nameoffs;
-
-    WHILE (CHL.GetByte(bytes, i) # 0) & (CHL.GetByte(bytes, j) # 0) &
-          (CHL.GetByte(bytes, i) = CHL.GetByte(bytes, j)) DO
-        INC(i);
-        INC(j)
-    END
-
-    RETURN CHL.GetByte(bytes, i) < CHL.GetByte(bytes, j)
-END less;
-
-
-PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
-VAR
-    exp, cur: EXPRT;
-
-BEGIN
-    NEW(exp);
-    exp.label := CHL.GetInt(program.labels, label);
-    exp.nameoffs := CHL.PushStr(program.export, name);
-
-    cur := program.exp_list.first(EXPRT);
-    WHILE (cur # NIL) & less(program.export, cur, exp) DO
-        cur := cur.next(EXPRT)
-    END;
-
-    IF cur # NIL THEN
-        IF cur.prev # NIL THEN
-            LISTS.insert(program.exp_list, cur.prev, exp)
-        ELSE
-            LISTS.insertL(program.exp_list, cur, exp)
-        END
-    ELSE
-        LISTS.push(program.exp_list, exp)
-    END
-
-END Export;
-
-
-PROCEDURE GetIProc* (program: PROGRAM; n: INTEGER): IMPRT;
-VAR
-    _import, res: IMPRT;
-
-BEGIN
-    _import  := program.imp_list.first(IMPRT);
-
-    res := NIL;
-    WHILE (_import # NIL) & (n >= 0) DO
-        IF _import.label # 0 THEN
-            res := _import;
-            DEC(n)
-        END;
-        _import := _import.next(IMPRT)
-    END;
-
-    ASSERT(n = -1)
-    RETURN res
-END GetIProc;
-
-
-PROCEDURE GetLabel* (program: PROGRAM; label: INTEGER): INTEGER;
-    RETURN CHL.GetInt(program.labels, label)
-END GetLabel;
-
-
-PROCEDURE NewLabel* (program: PROGRAM);
-BEGIN
-    CHL.PushInt(program.labels, 0)
-END NewLabel;
-
-
-PROCEDURE fixup* (program: PROGRAM);
-VAR
-    rel:    RELOC;
-    imp:    IMPRT;
-    nproc:  INTEGER;
-    L:      INTEGER;
-
-BEGIN
-
-    nproc := 0;
-    imp := program.imp_list.first(IMPRT);
-    WHILE imp # NIL DO
-        IF imp.label # 0 THEN
-            CHL.SetInt(program.labels, imp.label, nproc);
-            INC(nproc)
-        END;
-        imp := imp.next(IMPRT)
-    END;
-
-    rel := program.rel_list.first(RELOC);
-    WHILE rel # NIL DO
-
-        IF rel.opcode IN {RIMP, PICIMP} THEN
-            L := get32le(program.code, rel.offset);
-            put32le(program.code, rel.offset, GetLabel(program, L))
-        END;
-
-        rel := rel.next(RELOC)
-    END
-
-END fixup;
-
-
-PROCEDURE InitArray* (VAR _array: ARRAY OF BYTE; VAR idx: INTEGER; hex: ARRAY OF CHAR);
-VAR
-    i, k: INTEGER;
-
-
-    PROCEDURE hexdgt (dgt: CHAR): INTEGER;
-    VAR
-        res: INTEGER;
-
-    BEGIN
-        IF dgt < "A" THEN
-            res := ORD(dgt) - ORD("0")
-        ELSE
-            res := ORD(dgt) - ORD("A") + 10
-        END
-
-        RETURN res
-    END hexdgt;
-
-
-BEGIN
-    k := LENGTH(hex);
-    ASSERT(~ODD(k));
-    k := k DIV 2;
-
-    FOR i := 0 TO k - 1 DO
-        _array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1])
-    END;
-
-    INC(idx, k)
-END InitArray;
-
-
-END BIN.

programs/develop/oberon07/source/CHUNKLISTS.ob07

@@ -1,255 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE CHUNKLISTS;
-
-IMPORT LISTS, WR := WRITER;
-
-
-CONST
-
-    LENOFBYTECHUNK = 65536;
-    LENOFINTCHUNK  = 16384;
-
-
-TYPE
-
-    ANYLIST = POINTER TO RECORD (LISTS.LIST)
-
-        length: INTEGER
-
-    END;
-
-    BYTELIST* = POINTER TO RECORD (ANYLIST) END;
-
-    BYTECHUNK = POINTER TO RECORD (LISTS.ITEM)
-
-        data:   ARRAY LENOFBYTECHUNK OF BYTE;
-        count:  INTEGER
-
-    END;
-
-
-    INTLIST* = POINTER TO RECORD (ANYLIST) END;
-
-    INTCHUNK = POINTER TO RECORD (LISTS.ITEM)
-
-        data:   ARRAY LENOFINTCHUNK OF INTEGER;
-        count:  INTEGER
-
-    END;
-
-
-PROCEDURE SetByte* (list: BYTELIST; idx: INTEGER; byte: BYTE);
-VAR
-    chunk: BYTECHUNK;
-    item:  LISTS.ITEM;
-
-BEGIN
-    ASSERT(idx >= 0);
-    ASSERT(list # NIL);
-
-    item := LISTS.getidx(list, idx DIV LENOFBYTECHUNK);
-    ASSERT(item # NIL);
-    chunk := item(BYTECHUNK);
-    idx := idx MOD LENOFBYTECHUNK;
-    ASSERT(idx < chunk.count);
-    chunk.data[idx] := byte
-END SetByte;
-
-
-PROCEDURE GetByte* (list: BYTELIST; idx: INTEGER): BYTE;
-VAR
-    chunk: BYTECHUNK;
-    item:  LISTS.ITEM;
-
-BEGIN
-    ASSERT(idx >= 0);
-    ASSERT(list # NIL);
-
-    item := LISTS.getidx(list, idx DIV LENOFBYTECHUNK);
-    ASSERT(item # NIL);
-    chunk := item(BYTECHUNK);
-    idx := idx MOD LENOFBYTECHUNK;
-    ASSERT(idx < chunk.count)
-    RETURN chunk.data[idx]
-END GetByte;
-
-
-PROCEDURE PushByte* (list: BYTELIST; byte: BYTE);
-VAR
-    chunk: BYTECHUNK;
-
-BEGIN
-    ASSERT(list # NIL);
-
-    chunk := list.last(BYTECHUNK);
-
-    IF chunk.count = LENOFBYTECHUNK THEN
-        NEW(chunk);
-        chunk.count := 0;
-        LISTS.push(list, chunk)
-    END;
-
-    chunk.data[chunk.count] := byte;
-    INC(chunk.count);
-
-    INC(list.length)
-END PushByte;
-
-
-PROCEDURE PushStr* (list: BYTELIST; str: ARRAY OF CHAR): INTEGER;
-VAR
-    i, res: INTEGER;
-
-BEGIN
-    res := list.length;
-    i := 0;
-    REPEAT
-        PushByte(list, ORD(str[i]));
-        INC(i)
-    UNTIL str[i - 1] = 0X
-
-    RETURN res
-END PushStr;
-
-
-PROCEDURE GetStr* (list: BYTELIST; pos: INTEGER; VAR str: ARRAY OF CHAR): BOOLEAN;
-VAR
-    i:   INTEGER;
-    res: BOOLEAN;
-
-BEGIN
-    res := FALSE;
-    i := 0;
-    WHILE (pos < list.length) & (i < LEN(str)) & ~res DO
-        str[i] := CHR(GetByte(list, pos));
-        res := str[i] = 0X;
-        INC(pos);
-        INC(i)
-    END
-
-    RETURN res
-END GetStr;
-
-
-PROCEDURE WriteToFile* (list: BYTELIST);
-VAR
-    chunk: BYTECHUNK;
-
-BEGIN
-    chunk := list.first(BYTECHUNK);
-    WHILE chunk # NIL DO
-        WR.Write(chunk.data, chunk.count);
-        chunk := chunk.next(BYTECHUNK)
-    END
-END WriteToFile;
-
-
-PROCEDURE CreateByteList* (): BYTELIST;
-VAR
-    bytelist: BYTELIST;
-    list:     LISTS.LIST;
-    chunk:    BYTECHUNK;
-
-BEGIN
-    NEW(bytelist);
-    list := LISTS.create(bytelist);
-    bytelist.length := 0;
-
-    NEW(chunk);
-    chunk.count := 0;
-    LISTS.push(list, chunk)
-
-    RETURN list(BYTELIST)
-END CreateByteList;
-
-
-PROCEDURE SetInt* (list: INTLIST; idx: INTEGER; int: INTEGER);
-VAR
-    chunk: INTCHUNK;
-    item:  LISTS.ITEM;
-
-BEGIN
-    ASSERT(idx >= 0);
-    ASSERT(list # NIL);
-
-    item := LISTS.getidx(list, idx DIV LENOFINTCHUNK);
-    ASSERT(item # NIL);
-    chunk := item(INTCHUNK);
-    idx := idx MOD LENOFINTCHUNK;
-    ASSERT(idx < chunk.count);
-    chunk.data[idx] := int
-END SetInt;
-
-
-PROCEDURE GetInt* (list: INTLIST; idx: INTEGER): INTEGER;
-
-VAR
-    chunk: INTCHUNK;
-    item:  LISTS.ITEM;
-
-BEGIN
-    ASSERT(idx >= 0);
-    ASSERT(list # NIL);
-
-    item := LISTS.getidx(list, idx DIV LENOFINTCHUNK);
-    ASSERT(item # NIL);
-    chunk := item(INTCHUNK);
-    idx := idx MOD LENOFINTCHUNK;
-    ASSERT(idx < chunk.count)
-    RETURN chunk.data[idx]
-END GetInt;
-
-
-PROCEDURE PushInt* (list: INTLIST; int: INTEGER);
-VAR
-    chunk: INTCHUNK;
-
-BEGIN
-    ASSERT(list # NIL);
-
-    chunk := list.last(INTCHUNK);
-
-    IF chunk.count = LENOFINTCHUNK THEN
-        NEW(chunk);
-        chunk.count := 0;
-        LISTS.push(list, chunk)
-    END;
-
-    chunk.data[chunk.count] := int;
-    INC(chunk.count);
-
-    INC(list.length)
-END PushInt;
-
-
-PROCEDURE CreateIntList* (): INTLIST;
-VAR
-    intlist:  INTLIST;
-    list:     LISTS.LIST;
-    chunk:    INTCHUNK;
-
-BEGIN
-    NEW(intlist);
-    list := LISTS.create(intlist);
-    intlist.length := 0;
-
-    NEW(chunk);
-    chunk.count := 0;
-    LISTS.push(list, chunk)
-
-    RETURN list(INTLIST)
-END CreateIntList;
-
-
-PROCEDURE Length* (list: ANYLIST): INTEGER;
-    RETURN list.length
-END Length;
-
-
-END CHUNKLISTS.

programs/develop/oberon07/source/COLLECTIONS.ob07

@@ -1,59 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2019, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE COLLECTIONS;
-
-
-TYPE
-
-    ITEM* = POINTER TO RECORD
-
-        link: ITEM
-
-    END;
-
-    COLLECTION* = POINTER TO RECORD
-
-        last: ITEM
-
-    END;
-
-
-PROCEDURE push* (collection: COLLECTION; item: ITEM);
-BEGIN
-    item.link := collection.last;
-    collection.last := item
-END push;
-
-
-PROCEDURE pop* (collection: COLLECTION): ITEM;
-VAR
-    item: ITEM;
-
-BEGIN
-    item := collection.last;
-    IF item # NIL THEN
-        collection.last := item.link
-    END
-
-    RETURN item
-END pop;
-
-
-PROCEDURE create* (): COLLECTION;
-VAR
-    collection: COLLECTION;
-
-BEGIN
-    NEW(collection);
-    collection.last := NIL
-
-    RETURN collection
-END create;
-
-
-END COLLECTIONS.

programs/develop/oberon07/source/CONSOLE.ob07

@@ -1,78 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE CONSOLE;
-
-IMPORT UTILS, STRINGS;
-
-
-PROCEDURE String* (s: ARRAY OF CHAR);
-VAR
-    i: INTEGER;
-
-BEGIN
-    i := 0;
-    WHILE (i < LEN(s)) & (s[i] # 0X) DO
-        UTILS.OutChar(s[i]);
-        INC(i)
-    END
-END String;
-
-
-PROCEDURE Int* (x: INTEGER);
-VAR
-    s: ARRAY 24 OF CHAR;
-
-BEGIN
-    STRINGS.IntToStr(x, s);
-    String(s)
-END Int;
-
-
-PROCEDURE Int2* (x: INTEGER);
-BEGIN
-    IF x < 10 THEN
-        String("0")
-    END;
-    Int(x)
-END Int2;
-
-
-PROCEDURE Ln*;
-BEGIN
-    String(UTILS.eol)
-END Ln;
-
-
-PROCEDURE StringLn* (s: ARRAY OF CHAR);
-BEGIN
-    String(s);
-    Ln
-END StringLn;
-
-
-PROCEDURE IntLn* (x: INTEGER);
-BEGIN
-    Int(x);
-    Ln
-END IntLn;
-
-
-PROCEDURE Int2Ln* (x: INTEGER);
-BEGIN
-    Int2(x);
-    Ln
-END Int2Ln;
-
-
-PROCEDURE Dashes*;
-BEGIN
-    StringLn("------------------------------------------------")
-END Dashes;
-
-
-END CONSOLE.

programs/develop/oberon07/source/Compiler.ob07

@@ -1,352 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2023, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE Compiler;
-
-IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE,
-       ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS, SCAN, TEXTDRV;
-
-
-CONST
-
-    DEF_WINDOWS   = "WINDOWS";
-    DEF_LINUX     = "LINUX";
-    DEF_KOLIBRIOS = "KOLIBRIOS";
-    DEF_CPU_X86   = "CPU_X86";
-    DEF_CPU_X8664 = "CPU_X8664";
-
-
-PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH);
-VAR
-    param: PARS.PATH;
-    i, j:  INTEGER;
-    _end:  BOOLEAN;
-    value: INTEGER;
-    minor,
-    major: INTEGER;
-    checking: SET;
-
-
-    PROCEDURE getVal (VAR i: INTEGER; VAR value: INTEGER);
-    VAR
-        param: PARS.PATH;
-        val: INTEGER;
-    BEGIN
-        INC(i);
-        UTILS.GetArg(i, param);
-        IF STRINGS.StrToInt(param, val) THEN
-            value := val
-        END;
-        IF param[0] = "-" THEN
-            DEC(i)
-        END
-    END getVal;
-
-
-BEGIN
-    options.lower := TRUE;
-    out := "";
-    checking := options.checking;
-    _end := FALSE;
-    i := 3;
-    REPEAT
-        UTILS.GetArg(i, param);
-
-        IF param = "-stk" THEN
-            INC(i);
-            UTILS.GetArg(i, param);
-            IF STRINGS.StrToInt(param, value) & (1 <= value) & (value <= 32) THEN
-                options.stack := value
-            END;
-            IF param[0] = "-" THEN
-                DEC(i)
-            END
-
-        ELSIF param = "-out" THEN
-            INC(i);
-            UTILS.GetArg(i, param);
-            IF param[0] = "-" THEN
-                DEC(i)
-            ELSE
-                out := param
-            END
-
-        ELSIF param = "-tab" THEN
-            getVal(i, options.tab)
-
-        ELSIF param = "-ram" THEN
-            getVal(i, options.ram)
-
-        ELSIF param = "-rom" THEN
-            getVal(i, options.rom)
-
-        ELSIF param = "-nochk" THEN
-            INC(i);
-            UTILS.GetArg(i, param);
-
-            IF param[0] = "-" THEN
-                DEC(i)
-            ELSE
-                j := 0;
-                WHILE param[j] # 0X DO
-
-                    IF    param[j] = "p" THEN
-                        EXCL(checking, ST.chkPTR)
-                    ELSIF param[j] = "t" THEN
-                        EXCL(checking, ST.chkGUARD)
-                    ELSIF param[j] = "i" THEN
-                        EXCL(checking, ST.chkIDX)
-                    ELSIF param[j] = "b" THEN
-                        EXCL(checking, ST.chkBYTE)
-                    ELSIF param[j] = "c" THEN
-                        EXCL(checking, ST.chkCHR)
-                    ELSIF param[j] = "w" THEN
-                        EXCL(checking, ST.chkWCHR)
-                    ELSIF param[j] = "r" THEN
-                        EXCL(checking, ST.chkCHR);
-                        EXCL(checking, ST.chkWCHR);
-                        EXCL(checking, ST.chkBYTE)
-                    ELSIF param[j] = "s" THEN
-                        EXCL(checking, ST.chkSTK)
-                    ELSIF param[j] = "a" THEN
-                        checking := {}
-                    END;
-
-                    INC(j)
-                END;
-
-            END
-
-        ELSIF param = "-ver" THEN
-            INC(i);
-            UTILS.GetArg(i, param);
-            IF STRINGS.StrToVer(param, major, minor) THEN
-                options.version := major * 65536 + minor
-            END;
-            IF param[0] = "-" THEN
-                DEC(i)
-            END
-
-        ELSIF param = "-lower" THEN
-            options.lower := TRUE
-
-        ELSIF param = "-upper" THEN
-            options.lower := FALSE
-
-        ELSIF param = "-pic" THEN
-            options.pic := TRUE
-
-        ELSIF param = "-uses" THEN
-            options.uses := TRUE
-
-        ELSIF param = "-def" THEN
-            INC(i);
-            UTILS.GetArg(i, param);
-            SCAN.NewDef(param)
-
-        ELSIF param = "" THEN
-            _end := TRUE
-
-        ELSE
-            ERRORS.BadParam(param)
-        END;
-
-        INC(i)
-    UNTIL _end;
-
-    options.checking := checking
-END keys;
-
-
-PROCEDURE OutTargetItem (target: INTEGER; text: ARRAY OF CHAR);
-VAR
-    width: INTEGER;
-
-BEGIN
-    width := 15;
-    width := width - LENGTH(TARGETS.Targets[target].ComLinePar) - 4;
-    C.String("  '"); C.String(TARGETS.Targets[target].ComLinePar); C.String("'");
-    WHILE width > 0 DO
-        C.String(20X);
-        DEC(width)
-    END;
-    C.StringLn(text)
-END OutTargetItem;
-
-
-PROCEDURE main;
-VAR
-    path:       PARS.PATH;
-    inname:     PARS.PATH;
-    ext:        PARS.PATH;
-    app_path:   PARS.PATH;
-    lib_path:   PARS.PATH;
-    modname:    PARS.PATH;
-    outname:    PARS.PATH;
-    param:      PARS.PATH;
-    temp:       PARS.PATH;
-    target:     INTEGER;
-    time:       INTEGER;
-    options:    PROG.OPTIONS;
-
-BEGIN
-    options.stack := 2;
-    options.tab := TEXTDRV.defTabSize;
-    options.version := 65536;
-    options.pic := FALSE;
-    options.lower := FALSE;
-    options.uses := FALSE;
-    options.checking := ST.chkALL;
-
-    PATHS.GetCurrentDirectory(app_path);
-
-    UTILS.GetArg(0, temp);
-    PATHS.split(temp, path, modname, ext);
-    IF PATHS.isRelative(path) THEN
-        PATHS.RelPath(app_path, path, temp);
-        path := temp
-    END;
-    lib_path := path;
-
-    UTILS.GetArg(1, inname);
-    STRINGS.replace(inname, "\", UTILS.slash);
-    STRINGS.replace(inname, "/", UTILS.slash);
-
-    C.Ln;
-    C.String("Akron Oberon Compiler v"); C.Int(UTILS.vMajor); C.String("."); C.Int2(UTILS.vMinor);
-        C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit) " + UTILS.Date);
-    C.StringLn("Copyright (c) 2018-2023, Anton Krotov");
-
-    IF inname = "" THEN
-        C.Ln;
-        C.StringLn("Usage: Compiler <main module> <target> [optional settings]"); C.Ln;
-        C.StringLn("target =");
-        IF UTILS.bit_depth = 64 THEN
-            OutTargetItem(TARGETS.Win64C, "Windows64 Console");
-            OutTargetItem(TARGETS.Win64GUI, "Windows64 GUI");
-            OutTargetItem(TARGETS.Win64DLL, "Windows64 DLL");
-            OutTargetItem(TARGETS.Linux64, "Linux64 Exec");
-            OutTargetItem(TARGETS.Linux64SO, "Linux64 SO")
-        END;
-        OutTargetItem(TARGETS.Win32C, "Windows32 Console");
-        OutTargetItem(TARGETS.Win32GUI, "Windows32 GUI");
-        OutTargetItem(TARGETS.Win32DLL, "Windows32 DLL");
-        OutTargetItem(TARGETS.Linux32, "Linux32 Exec");
-        OutTargetItem(TARGETS.Linux32SO, "Linux32 SO");
-        OutTargetItem(TARGETS.KolibriOS, "KolibriOS Exec");
-        OutTargetItem(TARGETS.KolibriOSDLL, "KolibriOS DLL");
-        OutTargetItem(TARGETS.MSP430, "MSP430x{1,2}xx microcontrollers");
-        OutTargetItem(TARGETS.STM32CM3, "STM32 Cortex-M3 microcontrollers");
-        C.Ln;
-        C.StringLn("optional settings:"); C.Ln;
-        C.StringLn("  -out <file name>      output"); C.Ln;
-        C.StringLn("  -stk <size>           set size of stack in Mbytes (Windows, Linux, KolibriOS)"); C.Ln;
-        C.StringLn("  -nochk <'ptibcwra'>   disable runtime checking (pointers, types, indexes,");
-        C.StringLn("                        BYTE, CHR, WCHR)"); C.Ln;
-        C.StringLn("  -lower                allow lower case for keywords (default)"); C.Ln;
-        C.StringLn("  -upper                only upper case for keywords"); C.Ln;
-        C.StringLn("  -def <identifier>     define conditional compilation symbol"); C.Ln;
-        C.StringLn("  -ver <major.minor>    set version of program (KolibriOS DLL)"); C.Ln;
-        C.StringLn("  -ram <size>           set size of RAM in bytes (MSP430) or Kbytes (STM32)"); C.Ln;
-        C.StringLn("  -rom <size>           set size of ROM in bytes (MSP430) or Kbytes (STM32)"); C.Ln;
-        C.StringLn("  -tab <width>          set width for tabs"); C.Ln;
-        C.StringLn("  -uses                 list imported modules"); C.Ln;
-        UTILS.Exit(0)
-    END;
-
-    C.Dashes;
-    PATHS.split(inname, path, modname, ext);
-
-    IF ext # UTILS.FILE_EXT THEN
-        ERRORS.Error(207)
-    END;
-
-    IF PATHS.isRelative(path) THEN
-        PATHS.RelPath(app_path, path, temp);
-        path := temp
-    END;
-
-    UTILS.GetArg(2, param);
-    IF param = "" THEN
-        ERRORS.Error(205)
-    END;
-
-    SCAN.NewDef(param);
-
-    IF TARGETS.Select(param) THEN
-        target := TARGETS.target
-    ELSE
-        ERRORS.Error(206)
-    END;
-
-    IF TARGETS.CPU = TARGETS.cpuMSP430 THEN
-        options.ram := MSP430.minRAM;
-        options.rom := MSP430.minROM
-    END;
-
-    IF (TARGETS.CPU = TARGETS.cpuTHUMB) & (TARGETS.OS = TARGETS.osNONE) THEN
-        options.ram := THUMB.minRAM;
-        options.rom := THUMB.minROM
-    END;
-
-    IF UTILS.bit_depth < TARGETS.BitDepth THEN
-        ERRORS.Error(206)
-    END;
-
-    STRINGS.append(lib_path, "lib");
-    STRINGS.append(lib_path, UTILS.slash);
-    STRINGS.append(lib_path, TARGETS.LibDir);
-    STRINGS.append(lib_path, UTILS.slash);
-
-    keys(options, outname);
-    TEXTDRV.setTabSize(options.tab);
-    IF outname = "" THEN
-        outname := path;
-        STRINGS.append(outname, modname);
-        STRINGS.append(outname, TARGETS.FileExt)
-    ELSE
-        IF PATHS.isRelative(outname) THEN
-            PATHS.RelPath(app_path, outname, temp);
-            outname := temp
-        END
-    END;
-
-    PARS.init(options);
-
-    CASE TARGETS.OS OF
-    |TARGETS.osNONE:
-    |TARGETS.osWIN32,
-     TARGETS.osWIN64:   SCAN.NewDef(DEF_WINDOWS)
-    |TARGETS.osLINUX32,
-     TARGETS.osLINUX64: SCAN.NewDef(DEF_LINUX)
-    |TARGETS.osKOS:     SCAN.NewDef(DEF_KOLIBRIOS)
-    END;
-
-    CASE TARGETS.CPU OF
-    |TARGETS.cpuX86:    SCAN.NewDef(DEF_CPU_X86)
-    |TARGETS.cpuAMD64:  SCAN.NewDef(DEF_CPU_X8664)
-    |TARGETS.cpuMSP430:
-    |TARGETS.cpuTHUMB:
-    |TARGETS.cpuRVM32I:
-    |TARGETS.cpuRVM64I:
-    END;
-
-    ST.compile(path, lib_path, modname, outname, target, options);
-
-    time := UTILS.GetTickCount() - UTILS.time;
-    C.Dashes;
-    C.Int(PARS.lines); C.String(" lines, ");
-    C.Int(time DIV 100); C.String("."); C.Int2(time MOD 100); C.String(" sec, ");
-    C.Int(WRITER.counter); C.StringLn(" bytes");
-
-    UTILS.Exit(0)
-END main;
-
-
-BEGIN
-    main
-END Compiler.

programs/develop/oberon07/source/ELF.ob07

@@ -1,592 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2019-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE ELF;
-
-IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PE32, UTILS, STRINGS;
-
-
-CONST
-
-    EI_NIDENT = 16;
-    ET_EXEC = 2;
-    ET_DYN = 3;
-
-    EM_386 = 3;
-    EM_8664 = 3EH;
-
-    ELFCLASS32 = 1;
-    ELFCLASS64 = 2;
-
-    ELFDATA2LSB = 1;
-    ELFDATA2MSB = 2;
-
-    PF_X = 1;
-    PF_W = 2;
-    PF_R = 4;
-
-
-TYPE
-
-    Elf32_Ehdr = RECORD
-
-        e_ident: ARRAY EI_NIDENT OF BYTE;
-
-        e_type,
-        e_machine: WCHAR;
-
-        e_version,
-        e_entry,
-        e_phoff,
-        e_shoff,
-        e_flags: INTEGER;
-
-        e_ehsize,
-        e_phentsize,
-        e_phnum,
-        e_shentsize,
-        e_shnum,
-        e_shstrndx: WCHAR
-
-    END;
-
-
-    Elf32_Phdr = RECORD
-
-        p_type,
-        p_offset,
-        p_vaddr,
-        p_paddr,
-        p_filesz,
-        p_memsz,
-        p_flags,
-        p_align: INTEGER
-
-    END;
-
-
-    Elf32_Dyn = POINTER TO RECORD (LISTS.ITEM)
-
-        d_tag, d_val: INTEGER
-
-    END;
-
-
-    Elf32_Sym = POINTER TO RECORD (LISTS.ITEM)
-
-        name, value, size: INTEGER;
-        info, other: CHAR;
-        shndx: WCHAR
-
-    END;
-
-
-VAR
-
-    dynamic: LISTS.LIST;
-    strtab:  CHL.BYTELIST;
-    symtab:  LISTS.LIST;
-
-    hashtab, bucket, chain: CHL.INTLIST;
-
-
-PROCEDURE Write16 (w: WCHAR);
-BEGIN
-    WR.Write16LE(ORD(w))
-END Write16;
-
-
-PROCEDURE WritePH (ph: Elf32_Phdr);
-BEGIN
-    WR.Write32LE(ph.p_type);
-    WR.Write32LE(ph.p_offset);
-    WR.Write32LE(ph.p_vaddr);
-    WR.Write32LE(ph.p_paddr);
-    WR.Write32LE(ph.p_filesz);
-    WR.Write32LE(ph.p_memsz);
-    WR.Write32LE(ph.p_flags);
-    WR.Write32LE(ph.p_align)
-END WritePH;
-
-
-PROCEDURE WritePH64 (ph: Elf32_Phdr);
-BEGIN
-    WR.Write32LE(ph.p_type);
-    WR.Write32LE(ph.p_flags);
-    WR.Write64LE(ph.p_offset);
-    WR.Write64LE(ph.p_vaddr);
-    WR.Write64LE(ph.p_paddr);
-    WR.Write64LE(ph.p_filesz);
-    WR.Write64LE(ph.p_memsz);
-    WR.Write64LE(ph.p_align)
-END WritePH64;
-
-
-PROCEDURE NewDyn (tag, val: INTEGER);
-VAR
-    dyn: Elf32_Dyn;
-
-BEGIN
-    NEW(dyn);
-    dyn.d_tag := tag;
-    dyn.d_val := val;
-    LISTS.push(dynamic, dyn)
-END NewDyn;
-
-
-PROCEDURE NewSym (name, value, size: INTEGER; info, other: CHAR; shndx: WCHAR);
-VAR
-    sym: Elf32_Sym;
-
-BEGIN
-    NEW(sym);
-    sym.name := name;
-    sym.value := value;
-    sym.size := size;
-    sym.info := info;
-    sym.other := other;
-    sym.shndx := shndx;
-
-    LISTS.push(symtab, sym)
-END NewSym;
-
-
-PROCEDURE MakeHash (bucket, chain: CHL.INTLIST; symCount: INTEGER);
-VAR
-    symi, hi, k: INTEGER;
-
-BEGIN
-    FOR symi := 0 TO symCount - 1 DO
-        CHL.SetInt(chain, symi, 0);
-        hi := CHL.GetInt(hashtab, symi) MOD symCount;
-        IF CHL.GetInt(bucket, hi) # 0 THEN
-            k := symi;
-            WHILE CHL.GetInt(chain, k) # 0 DO
-                k := CHL.GetInt(chain, k)
-            END;
-            CHL.SetInt(chain, k, CHL.GetInt(bucket, hi))
-        END;
-        CHL.SetInt(bucket, hi, symi)
-    END
-END MakeHash;
-
-
-PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; fini: INTEGER; so, amd64: BOOLEAN);
-CONST
-    interp  =  0;
-    dyn     =  1;
-    header  =  2;
-    text    =  3;
-    data    =  4;
-    bss     =  5;
-
-    linuxInterpreter64 = "/lib64/ld-linux-x86-64.so.2";
-    linuxInterpreter32 = "/lib/ld-linux.so.2";
-
-    exeBaseAddress32 = 8048000H;
-    exeBaseAddress64 = 400000H;
-    dllBaseAddress = 0;
-
-    DT_NULL = 0;
-    DT_NEEDED = 1;
-    DT_HASH = 4;
-    DT_STRTAB = 5;
-    DT_SYMTAB = 6;
-    DT_RELA = 7;
-    DT_RELASZ = 8;
-    DT_RELAENT = 9;
-    DT_STRSZ = 10;
-    DT_SYMENT = 11;
-    DT_INIT = 12;
-    DT_FINI = 13;
-    DT_SONAME = 14;
-    DT_REL = 17;
-    DT_RELSZ = 18;
-    DT_RELENT = 19;
-
-VAR
-    ehdr: Elf32_Ehdr;
-    phdr: ARRAY 16 OF Elf32_Phdr;
-
-    i, BaseAdr, DynAdr, offset, pad, VA, symCount: INTEGER;
-
-    SizeOf: RECORD header, code, data, bss: INTEGER END;
-
-    Offset: RECORD symtab, reltab, hash, strtab: INTEGER END;
-
-    Interpreter: ARRAY 40 OF CHAR; lenInterpreter: INTEGER;
-
-    item: LISTS.ITEM;
-
-    Name: ARRAY 2048 OF CHAR;
-
-    Address: PE32.VIRTUAL_ADDR;
-
-BEGIN
-    dynamic := LISTS.create(NIL);
-    symtab  := LISTS.create(NIL);
-    strtab  := CHL.CreateByteList();
-
-    IF amd64 THEN
-        BaseAdr := exeBaseAddress64;
-        Interpreter := linuxInterpreter64
-    ELSE
-        BaseAdr := exeBaseAddress32;
-        Interpreter := linuxInterpreter32
-    END;
-
-    IF so THEN
-        BaseAdr := dllBaseAddress
-    END;
-
-    lenInterpreter := LENGTH(Interpreter) + 1;
-
-    SizeOf.code := CHL.Length(program.code);
-    SizeOf.data := CHL.Length(program.data);
-    SizeOf.bss  := program.bss;
-
-    ehdr.e_ident[0] := 7FH;
-    ehdr.e_ident[1] := ORD("E");
-    ehdr.e_ident[2] := ORD("L");
-    ehdr.e_ident[3] := ORD("F");
-    IF amd64 THEN
-        ehdr.e_ident[4] := ELFCLASS64
-    ELSE
-        ehdr.e_ident[4] := ELFCLASS32
-    END;
-    ehdr.e_ident[5] := ELFDATA2LSB;
-    ehdr.e_ident[6] := 1;
-    ehdr.e_ident[7] := 3;
-    FOR i := 8 TO EI_NIDENT - 1 DO
-        ehdr.e_ident[i] := 0
-    END;
-
-    IF so THEN
-        ehdr.e_type := WCHR(ET_DYN)
-    ELSE
-        ehdr.e_type := WCHR(ET_EXEC)
-    END;
-
-    ehdr.e_version := 1;
-    ehdr.e_shoff := 0;
-    ehdr.e_flags := 0;
-    ehdr.e_shnum := WCHR(0);
-    ehdr.e_shstrndx := WCHR(0);
-    ehdr.e_phnum := WCHR(6);
-
-    IF amd64 THEN
-        ehdr.e_machine := WCHR(EM_8664);
-        ehdr.e_phoff := 40H;
-        ehdr.e_ehsize := WCHR(40H);
-        ehdr.e_phentsize := WCHR(38H);
-        ehdr.e_shentsize := WCHR(40H)
-    ELSE
-        ehdr.e_machine := WCHR(EM_386);
-        ehdr.e_phoff := 34H;
-        ehdr.e_ehsize := WCHR(34H);
-        ehdr.e_phentsize := WCHR(20H);
-        ehdr.e_shentsize := WCHR(28H)
-    END;
-
-    SizeOf.header := ORD(ehdr.e_ehsize) + ORD(ehdr.e_phentsize) * ORD(ehdr.e_phnum);
-
-    phdr[interp].p_type := 3;
-    phdr[interp].p_offset := SizeOf.header;
-    phdr[interp].p_vaddr := BaseAdr + phdr[interp].p_offset;
-    phdr[interp].p_paddr := phdr[interp].p_vaddr;
-    phdr[interp].p_filesz := lenInterpreter;
-    phdr[interp].p_memsz := lenInterpreter;
-    phdr[interp].p_flags := PF_R;
-    phdr[interp].p_align := 1;
-
-    phdr[dyn].p_type := 2;
-    phdr[dyn].p_offset := phdr[interp].p_offset + phdr[interp].p_filesz;
-    phdr[dyn].p_vaddr := BaseAdr + phdr[dyn].p_offset;
-    phdr[dyn].p_paddr := phdr[dyn].p_vaddr;
-
-    hashtab := CHL.CreateIntList();
-
-    CHL.PushInt(hashtab, STRINGS.HashStr(""));
-    NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X);
-    CHL.PushInt(hashtab, STRINGS.HashStr("dlopen"));
-    NewSym(CHL.PushStr(strtab, "dlopen"), 0, 0, 12X, 0X, 0X);
-    CHL.PushInt(hashtab, STRINGS.HashStr("dlsym"));
-    NewSym(CHL.PushStr(strtab, "dlsym"), 0, 0, 12X, 0X, 0X);
-
-    IF so THEN
-        item := program.exp_list.first;
-        WHILE item # NIL DO
-            ASSERT(CHL.GetStr(program.export, item(BIN.EXPRT).nameoffs, Name));
-            CHL.PushInt(hashtab, STRINGS.HashStr(Name));
-            NewSym(CHL.PushStr(strtab, Name), item(BIN.EXPRT).label, 0, 12X, 0X, 0X);
-            item := item.next
-        END;
-        ASSERT(CHL.GetStr(program.data, program.modname, Name))
-    END;
-
-    symCount := LISTS.count(symtab);
-
-    bucket := CHL.CreateIntList();
-    chain  := CHL.CreateIntList();
-
-    FOR i := 1 TO symCount DO
-        CHL.PushInt(bucket, 0);
-        CHL.PushInt(chain, 0)
-    END;
-
-    MakeHash(bucket, chain, symCount);
-
-    NewDyn(DT_NEEDED, CHL.PushStr(strtab, "libdl.so.2"));
-    NewDyn(DT_STRTAB, 0);
-    NewDyn(DT_STRSZ, CHL.Length(strtab));
-    NewDyn(DT_SYMTAB, 0);
-
-    IF amd64 THEN
-        NewDyn(DT_SYMENT, 24);
-        NewDyn(DT_RELA, 0);
-        NewDyn(DT_RELASZ, 48);
-        NewDyn(DT_RELAENT, 24)
-    ELSE
-        NewDyn(DT_SYMENT, 16);
-        NewDyn(DT_REL, 0);
-        NewDyn(DT_RELSZ, 16);
-        NewDyn(DT_RELENT, 8)
-    END;
-
-    NewDyn(DT_HASH, 0);
-
-    IF so THEN
-        NewDyn(DT_SONAME, CHL.PushStr(strtab, Name));
-        NewDyn(DT_INIT, 0);
-        NewDyn(DT_FINI, 0)
-    END;
-
-    NewDyn(DT_NULL, 0);
-
-    Offset.symtab := LISTS.count(dynamic) * (8 + 8 * ORD(amd64));
-    Offset.reltab := Offset.symtab + symCount * (16 + 8 * ORD(amd64));
-    Offset.hash   := Offset.reltab + (8 + 16 * ORD(amd64)) * 2;
-    Offset.strtab := Offset.hash + (symCount * 2 + 2) * 4;
-
-    DynAdr := phdr[dyn].p_offset + BaseAdr;
-
-    item := LISTS.getidx(dynamic, 1); item(Elf32_Dyn).d_val := Offset.strtab + DynAdr;
-    item := LISTS.getidx(dynamic, 3); item(Elf32_Dyn).d_val := Offset.symtab + DynAdr;
-    item := LISTS.getidx(dynamic, 5); item(Elf32_Dyn).d_val := Offset.reltab + DynAdr;
-    item := LISTS.getidx(dynamic, 8); item(Elf32_Dyn).d_val := Offset.hash   + DynAdr;
-
-    phdr[dyn].p_filesz := Offset.strtab + CHL.Length(strtab) + 8 + 8 * ORD(amd64);
-    phdr[dyn].p_memsz  := phdr[dyn].p_filesz;
-
-    phdr[dyn].p_flags := PF_R;
-    phdr[dyn].p_align := 1;
-
-    offset := 0;
-
-    phdr[header].p_type := 1;
-    phdr[header].p_offset := offset;
-    phdr[header].p_vaddr := BaseAdr;
-    phdr[header].p_paddr := BaseAdr;
-    phdr[header].p_filesz := SizeOf.header + lenInterpreter + phdr[dyn].p_filesz;
-    phdr[header].p_memsz  := phdr[header].p_filesz;
-    phdr[header].p_flags := PF_R + PF_W;
-    phdr[header].p_align := 1000H;
-
-    INC(offset, phdr[header].p_filesz);
-    VA := BaseAdr + offset + 1000H;
-
-    phdr[text].p_type := 1;
-    phdr[text].p_offset := offset;
-    phdr[text].p_vaddr := VA;
-    phdr[text].p_paddr := VA;
-    phdr[text].p_filesz := SizeOf.code;
-    phdr[text].p_memsz := SizeOf.code;
-    phdr[text].p_flags := PF_X + PF_R;
-    phdr[text].p_align := 1000H;
-
-    ehdr.e_entry := phdr[text].p_vaddr;
-
-    INC(offset, phdr[text].p_filesz);
-    VA := BaseAdr + offset + 2000H;
-    pad := (16 - VA MOD 16) MOD 16;
-
-    phdr[data].p_type := 1;
-    phdr[data].p_offset := offset;
-    phdr[data].p_vaddr := VA;
-    phdr[data].p_paddr := VA;
-    phdr[data].p_filesz := SizeOf.data + pad;
-    phdr[data].p_memsz := SizeOf.data + pad;
-    phdr[data].p_flags := PF_R + PF_W;
-    phdr[data].p_align := 1000H;
-
-    INC(offset, phdr[data].p_filesz);
-    VA := BaseAdr + offset + 3000H;
-
-    phdr[bss].p_type := 1;
-    phdr[bss].p_offset := offset;
-    phdr[bss].p_vaddr := VA;
-    phdr[bss].p_paddr := VA;
-    phdr[bss].p_filesz := 0;
-    phdr[bss].p_memsz := SizeOf.bss + 16;
-    phdr[bss].p_flags := PF_R + PF_W;
-    phdr[bss].p_align := 1000H;
-
-    Address.Code   := ehdr.e_entry;
-    Address.Data   := phdr[data].p_vaddr + pad;
-    Address.Bss    := WR.align(phdr[bss].p_vaddr, 16);
-    Address.Import := 0;
-
-    PE32.fixup(program, Address, amd64);
-
-    item := symtab.first;
-    WHILE item # NIL DO
-        IF item(Elf32_Sym).value # 0 THEN
-            INC(item(Elf32_Sym).value, ehdr.e_entry)
-        END;
-        item := item.next
-    END;
-
-    IF so THEN
-        item := LISTS.getidx(dynamic, 10); item(Elf32_Dyn).d_val := ehdr.e_entry;
-        item := LISTS.getidx(dynamic, 11); item(Elf32_Dyn).d_val := BIN.GetLabel(program, fini) + ehdr.e_entry
-    END;
-
-    WR.Create(FileName);
-
-    FOR i := 0 TO EI_NIDENT - 1 DO
-        WR.WriteByte(ehdr.e_ident[i])
-    END;
-
-    Write16(ehdr.e_type);
-    Write16(ehdr.e_machine);
-
-    WR.Write32LE(ehdr.e_version);
-    IF amd64 THEN
-        WR.Write64LE(ehdr.e_entry);
-        WR.Write64LE(ehdr.e_phoff);
-        WR.Write64LE(ehdr.e_shoff)
-    ELSE
-        WR.Write32LE(ehdr.e_entry);
-        WR.Write32LE(ehdr.e_phoff);
-        WR.Write32LE(ehdr.e_shoff)
-    END;
-    WR.Write32LE(ehdr.e_flags);
-
-    Write16(ehdr.e_ehsize);
-    Write16(ehdr.e_phentsize);
-    Write16(ehdr.e_phnum);
-    Write16(ehdr.e_shentsize);
-    Write16(ehdr.e_shnum);
-    Write16(ehdr.e_shstrndx);
-
-    IF amd64 THEN
-        WritePH64(phdr[interp]);
-        WritePH64(phdr[dyn]);
-        WritePH64(phdr[header]);
-        WritePH64(phdr[text]);
-        WritePH64(phdr[data]);
-        WritePH64(phdr[bss])
-    ELSE
-        WritePH(phdr[interp]);
-        WritePH(phdr[dyn]);
-        WritePH(phdr[header]);
-        WritePH(phdr[text]);
-        WritePH(phdr[data]);
-        WritePH(phdr[bss])
-    END;
-
-    FOR i := 0 TO lenInterpreter - 1 DO
-        WR.WriteByte(ORD(Interpreter[i]))
-    END;
-
-    IF amd64 THEN
-        item := dynamic.first;
-        WHILE item # NIL DO
-            WR.Write64LE(item(Elf32_Dyn).d_tag);
-            WR.Write64LE(item(Elf32_Dyn).d_val);
-            item := item.next
-        END;
-
-        item := symtab.first;
-        WHILE item # NIL DO
-            WR.Write32LE(item(Elf32_Sym).name);
-            WR.WriteByte(ORD(item(Elf32_Sym).info));
-            WR.WriteByte(ORD(item(Elf32_Sym).other));
-            Write16(item(Elf32_Sym).shndx);
-            WR.Write64LE(item(Elf32_Sym).value);
-            WR.Write64LE(item(Elf32_Sym).size);
-            item := item.next
-        END;
-
-        WR.Write64LE(phdr[dyn].p_filesz + DynAdr - 16);
-        WR.Write32LE(1);
-        WR.Write32LE(1);
-        WR.Write64LE(0);
-        WR.Write64LE(phdr[dyn].p_filesz + DynAdr - 8);
-        WR.Write32LE(1);
-        WR.Write32LE(2);
-        WR.Write64LE(0)
-
-    ELSE
-        item := dynamic.first;
-        WHILE item # NIL DO
-            WR.Write32LE(item(Elf32_Dyn).d_tag);
-            WR.Write32LE(item(Elf32_Dyn).d_val);
-            item := item.next
-        END;
-
-        item := symtab.first;
-        WHILE item # NIL DO
-            WR.Write32LE(item(Elf32_Sym).name);
-            WR.Write32LE(item(Elf32_Sym).value);
-            WR.Write32LE(item(Elf32_Sym).size);
-            WR.WriteByte(ORD(item(Elf32_Sym).info));
-            WR.WriteByte(ORD(item(Elf32_Sym).other));
-            Write16(item(Elf32_Sym).shndx);
-            item := item.next
-        END;
-
-        WR.Write32LE(phdr[dyn].p_filesz + DynAdr - 8);
-        WR.Write32LE(00000101H);
-        WR.Write32LE(phdr[dyn].p_filesz + DynAdr - 4);
-        WR.Write32LE(00000201H)
-
-    END;
-
-    WR.Write32LE(symCount);
-    WR.Write32LE(symCount);
-
-    FOR i := 0 TO symCount - 1 DO
-        WR.Write32LE(CHL.GetInt(bucket, i))
-    END;
-
-    FOR i := 0 TO symCount - 1 DO
-        WR.Write32LE(CHL.GetInt(chain, i))
-    END;
-
-    CHL.WriteToFile(strtab);
-
-    IF amd64 THEN
-        WR.Write64LE(0);
-        WR.Write64LE(0)
-    ELSE
-        WR.Write32LE(0);
-        WR.Write32LE(0)
-    END;
-
-    CHL.WriteToFile(program.code);
-    WHILE pad > 0 DO
-        WR.WriteByte(0);
-        DEC(pad)
-    END;
-    CHL.WriteToFile(program.data);
-    WR.Close;
-    UTILS.chmod(FileName)
-END write;
-
-
-END ELF.

programs/develop/oberon07/source/ERRORS.ob07

@@ -1,222 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2022, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE ERRORS;
-
-IMPORT C := CONSOLE, UTILS;
-
-
-PROCEDURE HintMsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER);
-BEGIN
-    IF hint = 0 THEN
-        C.String("  hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
-        C.String("variable '"); C.String(name); C.StringLn("' never used")
-    END
-END HintMsg;
-
-
-PROCEDURE WarningMsg* (line, col, warning: INTEGER);
-BEGIN
-    C.String("  warning ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
-    CASE warning OF
-    |0: C.StringLn("passing a string value as a fixed array")
-    |1: C.StringLn("endless FOR loop")
-    |2: C.StringLn("identifier too long")
-    END
-END WarningMsg;
-
-
-PROCEDURE ErrorMsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER);
-VAR
-    str: ARRAY 80 OF CHAR;
-
-BEGIN
-    C.Ln;
-    C.String("  error  ("); C.Int(errno); C.String(") ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
-
-    CASE errno OF
-    |  1: str := "missing 'H' or 'X'"
-    |  2: str := "missing scale"
-    |  3: str := "unclosed string"
-    |  4: str := "illegal character"
-    |  5: str := "string too long"
-
-    |  7: str := "number too long"
-    |  8..12: str := "number too large"
-    | 13: str := "real numbers not supported"
-
-    | 21: str := "'MODULE' expected"
-    | 22: str := "identifier expected"
-    | 23: str := "module name does not match file name"
-    | 24: str := "';' expected"
-    | 25: str := "identifier does not match module name"
-    | 26: str := "'.' expected"
-    | 27: str := "'END' expected"
-    | 28: str := "',', ';' or ':=' expected"
-    | 29: str := "module not found"
-    | 30: str := "multiply defined identifier"
-    | 31: str := "recursive import"
-    | 32: str := "'=' expected"
-    | 33: str := "')' expected"
-    | 34: str := "syntax error in expression"
-    | 35: str := "'}' expected"
-    | 36: str := "incompatible operand"
-    | 37: str := "incompatible operands"
-    | 38: str := "'RETURN' expected"
-    | 39: str := "integer overflow"
-    | 40: str := "floating point overflow"
-    | 41: str := "not enough floating point registers; simplify expression"
-    | 42: str := "out of range 0..255"
-    | 43: str := "expression is not an integer"
-    | 44: str := "out of range 0..MAXSET"
-    | 45: str := "division by zero"
-    | 46: str := "IV out of range"
-    | 47: str := "'OF' or ',' expected"
-    | 48: str := "undeclared identifier"
-    | 49: str := "type expected"
-    | 50: str := "recursive type definition"
-    | 51: str := "illegal value of constant"
-    | 52: str := "not a record type"
-    | 53: str := "':' expected"
-    | 54: str := "need to import SYSTEM"
-    | 55: str := "pointer type not defined"
-    | 56: str := "out of range 0..MAXSET"
-    | 57: str := "'TO' expected"
-    | 58: str := "not a record type"
-    | 59: str := "this expression cannot be a procedure"
-    | 60: str := "identifier does not match procedure name"
-    | 61: str := "illegally marked identifier"
-    | 62: str := "expression should be constant"
-    | 63: str := "not enough RAM"
-    | 64: str := "'(' expected"
-    | 65: str := "',' expected"
-    | 66: str := "incompatible parameter"
-    | 67: str := "'OF' expected"
-    | 68: str := "type expected"
-    | 69: str := "result type of procedure is not a basic type"
-    | 70: str := "import not supported"
-    | 71: str := "']' expected"
-    | 72: str := "expression is not BOOLEAN"
-    | 73: str := "not a record"
-    | 74: str := "undefined record field"
-    | 75: str := "not an array"
-    | 76: str := "expression is not an integer"
-    | 77: str := "not a pointer"
-    | 78: str := "type guard not allowed"
-    | 79: str := "not a type"
-    | 80: str := "not a record type"
-    | 81: str := "not a pointer type"
-    | 82: str := "type guard not allowed"
-    | 83: str := "index out of range"
-    | 84: str := "dimension too large"
-    | 85: str := "procedure must have level 0"
-    | 86: str := "not a procedure"
-    | 87: str := "incompatible expression (RETURN)"
-    | 88: str := "'THEN' expected"
-    | 89: str := "'DO' expected"
-    | 90: str := "'UNTIL' expected"
-    | 91: str := "incompatible assignment"
-    | 92: str := "procedure call of a function"
-    | 93: str := "not a variable"
-    | 94: str := "read only variable"
-    | 95: str := "invalid type of expression (CASE)"
-    | 96: str := "':=' expected"
-    | 97: str := "not INTEGER variable"
-    | 98: str := "illegal value of constant (0)"
-    | 99: str := "incompatible label"
-    |100: str := "multiply defined label"
-    |101: str := "too large parameter of WCHR"
-    |102: str := "label expected"
-    |103: str := "illegal value of constant"
-    |104: str := "type too large"
-    |105: str := "access to intermediate variables not allowed"
-    |106: str := "qualified identifier expected"
-    |107: str := "too large parameter of CHR"
-    |108: str := "a variable or a procedure expected"
-    |109: str := "expression should be constant"
-    |110: str := "out of range 0..65535"
-    |111: str := "record [noalign] cannot have a base type"
-    |112: str := "record [noalign] cannot be a base type"
-    |113: str := "result type of procedure should not be REAL"
-    |114: str := "identifiers 'lib_init' and 'version' are reserved"
-    |115: str := "recursive constant definition"
-    |116: str := "procedure too deep nested"
-    |117: str := "string expected"
-    |118: str := "'$END', '$ELSE' or '$ELSIF' without '$IF'"
-    |119: str := "'$IF', '$ELSIF', '$ELSE' or '$END' expected"
-    |120: str := "too many formal parameters"
-    |121: str := "multiply defined handler"
-    |122: str := "bad divisor"
-    |123: str := "illegal flag"
-    |124: str := "unknown flag"
-    |125: str := "flag not supported"
-    |126: str := "type of formal parameter should not be REAL"
-    END;
-    C.StringLn(str);
-    C.String("  file:  ");  C.StringLn(fname);
-    UTILS.Exit(1)
-END ErrorMsg;
-
-
-PROCEDURE Error1 (s1: ARRAY OF CHAR);
-BEGIN
-    C.Ln;
-    C.StringLn(s1);
-    UTILS.Exit(1)
-END Error1;
-
-
-PROCEDURE Error3 (s1, s2, s3: ARRAY OF CHAR);
-BEGIN
-    C.Ln;
-    C.String(s1); C.String(s2); C.StringLn(s3);
-    UTILS.Exit(1)
-END Error3;
-
-
-PROCEDURE Error5 (s1, s2, s3, s4, s5: ARRAY OF CHAR);
-BEGIN
-    C.Ln;
-    C.String(s1); C.String(s2); C.String(s3); C.String(s4); C.StringLn(s5);
-    UTILS.Exit(1)
-END Error5;
-
-
-PROCEDURE WrongRTL* (ProcName: ARRAY OF CHAR);
-BEGIN
-    Error5("procedure ", UTILS.RTL_NAME, ".", ProcName, " not found")
-END WrongRTL;
-
-
-PROCEDURE BadParam* (param: ARRAY OF CHAR);
-BEGIN
-    Error3("bad parameter: ", param, "")
-END BadParam;
-
-
-PROCEDURE FileNotFound* (Path, Name, Ext: ARRAY OF CHAR);
-BEGIN
-    Error5("file ", Path, Name, Ext, " not found")
-END FileNotFound;
-
-
-PROCEDURE Error* (n: INTEGER);
-BEGIN
-    CASE n OF
-    |201: Error1("writing file error")
-    |202: Error1("too many relocations")
-    |203: Error1("size of program is too large")
-    |204: Error1("size of variables is too large")
-    |205: Error1("not enough parameters")
-    |206: Error1("bad parameter <target>")
-    |207: Error3('inputfile name extension must be "', UTILS.FILE_EXT, '"')
-    |208: Error1("not enough RAM")
-    END
-END Error;
-
-
-END ERRORS.

programs/develop/oberon07/source/FILES.ob07

@@ -1,200 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2022, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE FILES;
-
-IMPORT UTILS, C := COLLECTIONS;
-
-
-TYPE
-
-    FILE* = POINTER TO RECORD (C.ITEM)
-
-        ptr: INTEGER;
-
-        buffer: ARRAY 64*1024 OF BYTE;
-        count:  INTEGER
-
-    END;
-
-VAR
-
-    files: C.COLLECTION;
-
-
-PROCEDURE copy (src: ARRAY OF BYTE; src_idx: INTEGER; VAR dst: ARRAY OF BYTE; dst_idx: INTEGER; bytes: INTEGER);
-BEGIN
-    WHILE bytes > 0 DO
-        dst[dst_idx] := src[src_idx];
-        INC(dst_idx);
-        INC(src_idx);
-        DEC(bytes)
-    END
-END copy;
-
-
-PROCEDURE flush (file: FILE): INTEGER;
-VAR
-    res: INTEGER;
-
-BEGIN
-    IF file # NIL THEN
-        res := UTILS.FileWrite(file.ptr, file.buffer, file.count);
-        IF res < 0 THEN
-            res := 0
-        END
-    ELSE
-        res := 0
-    END
-
-    RETURN res
-END flush;
-
-
-PROCEDURE NewFile (): FILE;
-VAR
-    file:  FILE;
-    citem: C.ITEM;
-
-BEGIN
-    citem := C.pop(files);
-    IF citem = NIL THEN
-        NEW(file)
-    ELSE
-        file := citem(FILE)
-    END
-
-    RETURN file
-END NewFile;
-
-
-PROCEDURE create* (name: ARRAY OF CHAR): FILE;
-VAR
-    file: FILE;
-    ptr:  INTEGER;
-
-BEGIN
-    ptr := UTILS.FileCreate(name);
-
-    IF ptr > 0 THEN
-        file := NewFile();
-        file.ptr := ptr;
-        file.count := 0
-    ELSE
-        file := NIL
-    END
-
-    RETURN file
-END create;
-
-
-PROCEDURE open* (name: ARRAY OF CHAR): FILE;
-VAR
-    file: FILE;
-    ptr:  INTEGER;
-
-BEGIN
-    ptr := UTILS.FileOpen(name);
-
-    IF ptr > 0 THEN
-        file := NewFile();
-        file.ptr := ptr;
-        file.count := -1
-    ELSE
-        file := NIL
-    END
-
-    RETURN file
-END open;
-
-
-PROCEDURE close* (VAR file: FILE);
-VAR
-    n: INTEGER;
-
-BEGIN
-    IF file # NIL THEN
-
-        IF file.count > 0 THEN
-            n := flush(file)
-        END;
-
-        file.count := -1;
-
-        UTILS.FileClose(file.ptr);
-        file.ptr := 0;
-
-        C.push(files, file);
-        file := NIL
-    END
-END close;
-
-
-PROCEDURE read* (file: FILE; VAR chunk: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
-VAR
-    res: INTEGER;
-
-BEGIN
-    IF file # NIL THEN
-        res := UTILS.FileRead(file.ptr, chunk, MAX(MIN(bytes, LEN(chunk)), 0));
-        IF res < 0 THEN
-            res := 0
-        END
-    ELSE
-        res := 0
-    END
-
-    RETURN res
-END read;
-
-
-PROCEDURE write* (file: FILE; chunk: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
-VAR
-    free, n, idx: INTEGER;
-
-BEGIN
-    idx := 0;
-    IF (file # NIL) & (file.count >= 0) THEN
-
-        free := LEN(file.buffer) - file.count;
-        WHILE bytes > 0 DO
-            n := MIN(free, bytes);
-            copy(chunk, idx, file.buffer, file.count, n);
-            DEC(free, n);
-            DEC(bytes, n);
-            INC(idx, n);
-            INC(file.count, n);
-            IF free = 0 THEN
-                IF flush(file) # LEN(file.buffer) THEN
-                    bytes := 0;
-                    DEC(idx, n)
-                ELSE
-                    file.count := 0;
-                    free := LEN(file.buffer)
-                END
-            END
-        END
-
-    END
-
-    RETURN idx
-END write;
-
-
-PROCEDURE WriteByte* (file: FILE; byte: BYTE): BOOLEAN;
-VAR
-    arr: ARRAY 1 OF BYTE;
-
-BEGIN
-    arr[0] := byte
-    RETURN write(file, arr, 1) = 1
-END WriteByte;
-
-
-BEGIN
-    files := C.create()
-END FILES.

programs/develop/oberon07/source/HEX.ob07

@@ -1,117 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2020, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE HEX;
-
-IMPORT WRITER, CHL := CHUNKLISTS, UTILS;
-
-
-VAR
-
-    chksum: INTEGER;
-
-
-PROCEDURE Byte (byte: BYTE);
-BEGIN
-    WRITER.WriteByte(UTILS.hexdgt(byte DIV 16));
-    WRITER.WriteByte(UTILS.hexdgt(byte MOD 16));
-    INC(chksum, byte)
-END Byte;
-
-
-PROCEDURE Byte4 (a, b, c, d: BYTE);
-BEGIN
-    Byte(a);
-    Byte(b);
-    Byte(c);
-    Byte(d)
-END Byte4;
-
-
-PROCEDURE NewLine;
-BEGIN
-    Byte((-chksum) MOD 256);
-    chksum := 0;
-    WRITER.WriteByte(0DH);
-    WRITER.WriteByte(0AH)
-END NewLine;
-
-
-PROCEDURE StartCode;
-BEGIN
-    WRITER.WriteByte(ORD(":"));
-    chksum := 0
-END StartCode;
-
-
-PROCEDURE Data* (mem: ARRAY OF BYTE; idx, cnt: INTEGER);
-VAR
-    i, len: INTEGER;
-
-BEGIN
-    WHILE cnt > 0 DO
-        len := MIN(cnt, 16);
-        StartCode;
-        Byte4(len, idx DIV 256, idx MOD 256, 0);
-        FOR i := 1 TO len DO
-            Byte(mem[idx]);
-            INC(idx)
-        END;
-        DEC(cnt, len);
-        NewLine
-    END
-END Data;
-
-
-PROCEDURE ExtLA* (LA: INTEGER);
-BEGIN
-    ASSERT((0 <= LA) & (LA <= 0FFFFH));
-    StartCode;
-    Byte4(2, 0, 0, 4);
-    Byte(LA DIV 256);
-    Byte(LA MOD 256);
-    NewLine
-END ExtLA;
-
-
-PROCEDURE Data2* (mem: CHL.BYTELIST; idx, cnt, LA: INTEGER);
-VAR
-    i, len, offset: INTEGER;
-
-BEGIN
-    ExtLA(LA);
-    offset := 0;
-    WHILE cnt > 0 DO
-        ASSERT(offset <= 65536);
-        IF offset = 65536 THEN
-            INC(LA);
-            ExtLA(LA);
-            offset := 0
-        END;
-        len := MIN(cnt, 16);
-        StartCode;
-        Byte4(len, offset DIV 256, offset MOD 256, 0);
-        FOR i := 1 TO len DO
-            Byte(CHL.GetByte(mem, idx));
-            INC(idx);
-            INC(offset)
-        END;
-        DEC(cnt, len);
-        NewLine
-    END
-END Data2;
-
-
-PROCEDURE End*;
-BEGIN
-    StartCode;
-    Byte4(0, 0, 0, 1);
-    NewLine
-END End;
-
-
-END HEX.

programs/develop/oberon07/source/KOS.ob07

@@ -1,206 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2020, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE KOS;
-
-IMPORT BIN, WR := WRITER, LISTS, CHL := CHUNKLISTS;
-
-
-CONST
-
-    HEADER_SIZE = 36;
-
-    SIZE_OF_DWORD = 4;
-
-
-TYPE
-
-    HEADER = RECORD
-
-        menuet01: ARRAY 9 OF CHAR;
-        ver, start, size, mem, sp, param, path: INTEGER
-
-    END;
-
-
-PROCEDURE Import* (program: BIN.PROGRAM; idata: INTEGER; VAR ImportTable: CHL.INTLIST; VAR len, libcount, size: INTEGER);
-VAR
-    i:   INTEGER;
-    imp: BIN.IMPRT;
-
-BEGIN
-    libcount  := 0;
-    imp := program.imp_list.first(BIN.IMPRT);
-    WHILE imp # NIL DO
-        IF imp.label = 0 THEN
-            INC(libcount)
-        END;
-        imp := imp.next(BIN.IMPRT)
-    END;
-
-    len  := libcount * 2 + 2;
-    size := (LISTS.count(program.imp_list) + len + 1) * SIZE_OF_DWORD;
-
-    ImportTable := CHL.CreateIntList();
-    FOR i := 0 TO size DIV SIZE_OF_DWORD - 1 DO
-        CHL.PushInt(ImportTable, 0)
-    END;
-
-    i := 0;
-    imp := program.imp_list.first(BIN.IMPRT);
-    WHILE imp # NIL DO
-
-        IF imp.label = 0 THEN
-            CHL.SetInt(ImportTable, len, 0);
-            INC(len);
-            CHL.SetInt(ImportTable, i, idata + len * SIZE_OF_DWORD);
-            INC(i);
-            CHL.SetInt(ImportTable, i, imp.nameoffs + size + idata);
-            INC(i)
-        ELSE
-            CHL.SetInt(ImportTable, len, imp.nameoffs + size + idata);
-            imp.label := len * SIZE_OF_DWORD;
-            INC(len)
-        END;
-
-        imp := imp.next(BIN.IMPRT)
-    END;
-    CHL.SetInt(ImportTable, len, 0);
-    CHL.SetInt(ImportTable, i, 0);
-    CHL.SetInt(ImportTable, i + 1, 0);
-    INC(len);
-    INC(size, CHL.Length(program._import))
-END Import;
-
-
-PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR);
-
-CONST
-
-    PARAM_SIZE    = 2048;
-    FileAlignment = 16;
-
-
-VAR
-    header: HEADER;
-
-    base, text, data, idata, bss, offset: INTEGER;
-
-    reloc:   BIN.RELOC;
-    iproc:   BIN.IMPRT;
-    L:       INTEGER;
-    delta:   INTEGER;
-
-    i: INTEGER;
-
-    ImportTable: CHL.INTLIST;
-    ILen, libcount, isize: INTEGER;
-
-    icount, dcount, ccount: INTEGER;
-
-    code: CHL.BYTELIST;
-
-BEGIN
-    base := 0;
-
-    icount := CHL.Length(program._import);
-    dcount := CHL.Length(program.data);
-    ccount := CHL.Length(program.code);
-
-    text  := base + HEADER_SIZE;
-    data  := WR.align(text + ccount, FileAlignment);
-    idata := WR.align(data + dcount, FileAlignment);
-
-    Import(program, idata, ImportTable, ILen, libcount, isize);
-
-    bss := WR.align(idata + isize, FileAlignment);
-
-    header.menuet01 := "MENUET01";
-    header.ver      :=  1;
-    header.start    :=  text;
-    header.size     :=  idata + isize - base;
-    header.mem      :=  WR.align(header.size + program.stack + program.bss + PARAM_SIZE * 2 + 4096, FileAlignment);
-    header.sp       :=  base + header.mem - PARAM_SIZE * 2;
-    header.param    :=  header.sp;
-    header.path     :=  header.param + PARAM_SIZE;
-
-    code := program.code;
-    reloc := program.rel_list.first(BIN.RELOC);
-    WHILE reloc # NIL DO
-
-        offset := reloc.offset;
-        L := BIN.get32le(code, offset);
-        delta := 3 - offset - text;
-
-        CASE reloc.opcode OF
-
-        |BIN.RIMP:
-              iproc := BIN.GetIProc(program, L);
-              delta := idata + iproc.label
-
-        |BIN.RBSS:
-              delta := L + bss
-
-        |BIN.RDATA:
-              delta := L + data
-
-        |BIN.RCODE:
-              delta := BIN.GetLabel(program, L) + text
-
-        |BIN.PICDATA:
-              INC(delta, L + data)
-
-        |BIN.PICCODE:
-              INC(delta, BIN.GetLabel(program, L) + text)
-
-        |BIN.PICBSS:
-              INC(delta, L + bss)
-
-        |BIN.PICIMP:
-              iproc := BIN.GetIProc(program, L);
-              INC(delta, idata + iproc.label)
-
-        |BIN.IMPTAB:
-              INC(delta, idata)
-
-        END;
-        BIN.put32le(code, offset, delta);
-
-        reloc := reloc.next(BIN.RELOC)
-    END;
-
-    WR.Create(FileName);
-
-    FOR i := 0 TO 7 DO
-        WR.WriteByte(ORD(header.menuet01[i]))
-    END;
-
-    WR.Write32LE(header.ver);
-    WR.Write32LE(header.start);
-    WR.Write32LE(header.size);
-    WR.Write32LE(header.mem);
-    WR.Write32LE(header.sp);
-    WR.Write32LE(header.param);
-    WR.Write32LE(header.path);
-
-    CHL.WriteToFile(code);
-    WR.Padding(FileAlignment);
-
-    CHL.WriteToFile(program.data);
-    WR.Padding(FileAlignment);
-
-    FOR i := 0 TO ILen - 1 DO
-        WR.Write32LE(CHL.GetInt(ImportTable, i))
-    END;
-
-    CHL.WriteToFile(program._import);
-
-    WR.Close
-END write;
-
-
-END KOS.

programs/develop/oberon07/source/LISTS.ob07

@@ -1,199 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE LISTS;
-
-IMPORT C := COLLECTIONS;
-
-
-TYPE
-
-    ITEM* = POINTER TO RECORD (C.ITEM)
-
-        prev*, next*: ITEM
-
-    END;
-
-    LIST* = POINTER TO RECORD
-
-        first*, last*: ITEM
-
-    END;
-
-
-PROCEDURE push* (list: LIST; item: ITEM);
-BEGIN
-    ASSERT(list # NIL);
-    ASSERT(item # NIL);
-
-    IF list.first = NIL THEN
-        list.first := item;
-        item.prev  := NIL
-    ELSE
-        ASSERT(list.last # NIL);
-        item.prev := list.last;
-        list.last.next := item
-    END;
-    list.last := item;
-    item.next := NIL
-END push;
-
-
-PROCEDURE pop* (list: LIST): ITEM;
-VAR
-    last: ITEM;
-
-BEGIN
-    ASSERT(list # NIL);
-
-    last := list.last;
-
-    IF last # NIL THEN
-        IF last = list.first THEN
-            list.first := NIL;
-            list.last := NIL
-        ELSE
-            list.last := last.prev;
-            list.last.next := NIL
-        END;
-
-        last.next := NIL;
-        last.prev := NIL
-    END
-
-    RETURN last
-END pop;
-
-
-PROCEDURE insert* (list: LIST; cur, nov: ITEM);
-VAR
-    next: ITEM;
-
-BEGIN
-    ASSERT(list # NIL);
-    ASSERT(nov # NIL);
-    ASSERT(cur # NIL);
-
-    next := cur.next;
-
-    IF next # NIL THEN
-        next.prev := nov;
-        nov.next := next;
-        cur.next := nov;
-        nov.prev := cur
-    ELSE
-        push(list, nov)
-    END
-
-END insert;
-
-
-PROCEDURE insertL* (list: LIST; cur, nov: ITEM);
-VAR
-    prev: ITEM;
-
-BEGIN
-    ASSERT(list # NIL);
-    ASSERT(nov # NIL);
-    ASSERT(cur # NIL);
-
-    prev := cur.prev;
-
-    IF prev # NIL THEN
-        prev.next := nov;
-        nov.prev := prev
-    ELSE
-        nov.prev := NIL;
-        list.first := nov
-    END;
-    cur.prev := nov;
-    nov.next := cur
-END insertL;
-
-
-PROCEDURE delete* (list: LIST; item: ITEM);
-VAR
-    prev, next: ITEM;
-
-BEGIN
-    ASSERT(list # NIL);
-    ASSERT(item # NIL);
-
-    prev := item.prev;
-    next := item.next;
-
-    IF next # NIL THEN
-        IF prev # NIL THEN
-            prev.next := next;
-            next.prev := prev
-        ELSE
-            next.prev := NIL;
-            list.first := next
-        END
-    ELSE
-        IF prev # NIL THEN
-            prev.next := NIL;
-            list.last := prev
-        ELSE
-            list.first := NIL;
-            list.last := NIL
-        END
-    END
-END delete;
-
-
-PROCEDURE count* (list: LIST): INTEGER;
-VAR
-    item: ITEM;
-    res:  INTEGER;
-
-BEGIN
-    ASSERT(list # NIL);
-    res := 0;
-
-    item := list.first;
-    WHILE item # NIL DO
-        INC(res);
-        item := item.next
-    END
-
-    RETURN res
-END count;
-
-
-PROCEDURE getidx* (list: LIST; idx: INTEGER): ITEM;
-VAR
-    item: ITEM;
-
-BEGIN
-    ASSERT(list # NIL);
-    ASSERT(idx >= 0);
-
-    item := list.first;
-    WHILE (item # NIL) & (idx > 0) DO
-        item := item.next;
-        DEC(idx)
-    END
-
-    RETURN item
-END getidx;
-
-
-PROCEDURE create* (list: LIST): LIST;
-BEGIN
-    IF list = NIL THEN
-        NEW(list)
-    END;
-
-    list.first := NIL;
-    list.last  := NIL
-
-    RETURN list
-END create;
-
-
-END LISTS.

programs/develop/oberon07/source/MSCOFF.ob07

@@ -1,309 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2020, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE MSCOFF;
-
-IMPORT BIN, PE32, KOS, WR := WRITER, UTILS, ERRORS, LISTS, CHL := CHUNKLISTS;
-
-
-CONST
-
-    SIZE_OF_DWORD = 4;
-
-    (* SectionHeader.Characteristics *)
-
-    SHC_flat  = 040500020H;
-    SHC_data  = 0C0500040H;
-    SHC_bss   = 0C03000C0H;
-
-
-TYPE
-
-    FH = PE32.IMAGE_FILE_HEADER;
-
-    SH = PE32.IMAGE_SECTION_HEADER;
-
-
-PROCEDURE WriteReloc (VirtualAddress, SymbolTableIndex, Type: INTEGER);
-BEGIN
-    WR.Write32LE(VirtualAddress);
-    WR.Write32LE(SymbolTableIndex);
-    WR.Write16LE(Type)
-END WriteReloc;
-
-
-PROCEDURE Reloc (program: BIN.PROGRAM);
-VAR
-    reloc:  BIN.RELOC;
-    offset: INTEGER;
-
-BEGIN
-    reloc := program.rel_list.first(BIN.RELOC);
-    WHILE reloc # NIL DO
-
-        offset := reloc.offset;
-        CASE reloc.opcode OF
-        |BIN.RIMP,
-         BIN.IMPTAB: WriteReloc(offset, 4, 6)
-        |BIN.RBSS:   WriteReloc(offset, 5, 6)
-        |BIN.RDATA:  WriteReloc(offset, 2, 6)
-        |BIN.RCODE:  WriteReloc(offset, 1, 6)
-        END;
-
-        reloc := reloc.next(BIN.RELOC)
-    END;
-END Reloc;
-
-
-PROCEDURE RelocCount (program: BIN.PROGRAM): INTEGER;
-VAR
-    reloc:   BIN.RELOC;
-    iproc:   BIN.IMPRT;
-    res, L:  INTEGER;
-    offset:  INTEGER;
-    code:    CHL.BYTELIST;
-
-BEGIN
-    res := 0;
-    code := program.code;
-    reloc := program.rel_list.first(BIN.RELOC);
-    WHILE reloc # NIL DO
-
-        INC(res);
-        offset := reloc.offset;
-
-        IF reloc.opcode = BIN.RIMP THEN
-            L := BIN.get32le(code, offset);
-            iproc := BIN.GetIProc(program, L);
-            BIN.put32le(code, offset, iproc.label)
-        END;
-
-        IF reloc.opcode = BIN.RCODE THEN
-            L := BIN.get32le(code, offset);
-            BIN.put32le(code, offset, BIN.GetLabel(program, L))
-        END;
-
-        reloc := reloc.next(BIN.RELOC)
-    END
-
-    RETURN res
-END RelocCount;
-
-
-PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; ver: INTEGER);
-VAR
-    exp:   BIN.EXPRT;
-    n, i:  INTEGER;
-
-    szversion: PE32.NAME;
-
-    ImportTable: CHL.INTLIST;
-    ILen, LibCount, isize:  INTEGER;
-
-    ExpCount: INTEGER;
-
-    icount, ecount, dcount, ccount: INTEGER;
-
-    FileHeader: FH;
-
-    flat, data, edata, idata, bss: SH;
-
-
-    PROCEDURE ICount (ImportTable: CHL.INTLIST; ILen: INTEGER): INTEGER;
-    VAR
-        i, res: INTEGER;
-
-    BEGIN
-        res := 0;
-
-        FOR i := 0 TO ILen - 1 DO
-            IF CHL.GetInt(ImportTable, i) # 0 THEN
-                INC(res)
-            END
-        END
-
-        RETURN res
-    END ICount;
-
-
-    PROCEDURE SetNumberOfRelocations (VAR section: SH; NumberOfRelocations: INTEGER);
-    BEGIN
-        IF NumberOfRelocations >= 65536 THEN
-            ERRORS.Error(202)
-        END;
-        section.NumberOfRelocations := WCHR(NumberOfRelocations)
-    END SetNumberOfRelocations;
-
-
-BEGIN
-
-    szversion := "version";
-
-    ASSERT(LENGTH(szversion) = 7);
-
-    KOS.Import(program, 0, ImportTable, ILen, LibCount, isize);
-    ExpCount := LISTS.count(program.exp_list);
-
-    icount := CHL.Length(program._import);
-    dcount := CHL.Length(program.data);
-    ccount := CHL.Length(program.code);
-    ecount := CHL.Length(program.export);
-
-    FileHeader.Machine               :=  014CX;
-    FileHeader.NumberOfSections      :=  5X;
-    FileHeader.TimeDateStamp         :=  UTILS.UnixTime();
-    (* FileHeader.PointerToSymbolTable  :=  0; *)
-    FileHeader.NumberOfSymbols       :=  6;
-    FileHeader.SizeOfOptionalHeader  :=  0X;
-    FileHeader.Characteristics       :=  0184X;
-
-    flat.Name := ".flat";
-    flat.VirtualSize := 0;
-    flat.VirtualAddress := 0;
-    flat.SizeOfRawData := ccount;
-    flat.PointerToRawData := ORD(FileHeader.NumberOfSections) * PE32.SIZE_OF_IMAGE_SECTION_HEADER + PE32.SIZE_OF_IMAGE_FILE_HEADER;
-    (* flat.PointerToRelocations := 0; *)
-    flat.PointerToLinenumbers := 0;
-    SetNumberOfRelocations(flat, RelocCount(program));
-    flat.NumberOfLinenumbers := 0X;
-    flat.Characteristics := SHC_flat;
-
-    data.Name := ".data";
-    data.VirtualSize := 0;
-    data.VirtualAddress := 0;
-    data.SizeOfRawData := dcount;
-    data.PointerToRawData := flat.PointerToRawData + flat.SizeOfRawData;
-    data.PointerToRelocations := 0;
-    data.PointerToLinenumbers := 0;
-    data.NumberOfRelocations := 0X;
-    data.NumberOfLinenumbers := 0X;
-    data.Characteristics := SHC_data;
-
-    edata.Name := ".edata";
-    edata.VirtualSize := 0;
-    edata.VirtualAddress := 0;
-    edata.SizeOfRawData := ((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD + LENGTH(szversion) + 1 + ecount;
-    edata.PointerToRawData := data.PointerToRawData + data.SizeOfRawData;
-    (* edata.PointerToRelocations := 0; *)
-    edata.PointerToLinenumbers := 0;
-    SetNumberOfRelocations(edata, ExpCount * 2 + 1);
-    edata.NumberOfLinenumbers := 0X;
-    edata.Characteristics := SHC_data;
-
-    idata.Name := ".idata";
-    idata.VirtualSize := 0;
-    idata.VirtualAddress := 0;
-    idata.SizeOfRawData := isize;
-    idata.PointerToRawData := edata.PointerToRawData + edata.SizeOfRawData;
-    (* idata.PointerToRelocations := 0; *)
-    idata.PointerToLinenumbers := 0;
-    SetNumberOfRelocations(idata, ICount(ImportTable, ILen));
-    idata.NumberOfLinenumbers := 0X;
-    idata.Characteristics := SHC_data;
-
-    bss.Name := ".bss";
-    bss.VirtualSize := 0;
-    bss.VirtualAddress := 0;
-    bss.SizeOfRawData := program.bss;
-    bss.PointerToRawData := 0;
-    bss.PointerToRelocations := 0;
-    bss.PointerToLinenumbers := 0;
-    bss.NumberOfRelocations := 0X;
-    bss.NumberOfLinenumbers := 0X;
-    bss.Characteristics := SHC_bss;
-
-    flat.PointerToRelocations := idata.PointerToRawData + idata.SizeOfRawData;
-    edata.PointerToRelocations := flat.PointerToRelocations + ORD(flat.NumberOfRelocations) * 10;
-    idata.PointerToRelocations := edata.PointerToRelocations + ORD(edata.NumberOfRelocations) * 10;
-
-    FileHeader.PointerToSymbolTable := idata.PointerToRelocations + ORD(idata.NumberOfRelocations) * 10;
-
-    WR.Create(FileName);
-
-    PE32.WriteFileHeader(FileHeader);
-
-    PE32.WriteSectionHeader(flat);
-    PE32.WriteSectionHeader(data);
-    PE32.WriteSectionHeader(edata);
-    PE32.WriteSectionHeader(idata);
-    PE32.WriteSectionHeader(bss);
-
-    CHL.WriteToFile(program.code);
-    CHL.WriteToFile(program.data);
-
-    exp := program.exp_list.first(BIN.EXPRT);
-    WHILE exp # NIL DO
-        WR.Write32LE(exp.nameoffs + edata.SizeOfRawData - ecount);
-        WR.Write32LE(exp.label);
-        exp := exp.next(BIN.EXPRT)
-    END;
-
-    WR.Write32LE(((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD);
-    WR.Write32LE(ver);
-
-    WR.Write32LE(0);
-
-    PE32.WriteName(szversion);
-    CHL.WriteToFile(program.export);
-
-    FOR i := 0 TO ILen - 1 DO
-        WR.Write32LE(CHL.GetInt(ImportTable, i))
-    END;
-
-    CHL.WriteToFile(program._import);
-
-    Reloc(program);
-
-    n := 0;
-    exp := program.exp_list.first(BIN.EXPRT);
-    WHILE exp # NIL DO
-        WriteReloc(n, 3, 6);
-        INC(n, 4);
-
-        WriteReloc(n, 1, 6);
-        INC(n, 4);
-
-        exp := exp.next(BIN.EXPRT)
-    END;
-
-    WriteReloc(n, 3, 6);
-
-    FOR i := 0 TO LibCount * 2 - 1 DO
-        WriteReloc(i * SIZE_OF_DWORD, 4, 6)
-    END;
-
-    FOR i := LibCount * 2 TO ILen - 1 DO
-        IF CHL.GetInt(ImportTable, i) # 0 THEN
-            WriteReloc(i * SIZE_OF_DWORD, 4, 6)
-        END
-    END;
-
-    PE32.WriteName("EXPORTS");
-    WriteReloc(0, 3, 2);
-
-    PE32.WriteName(".flat");
-    WriteReloc(0, 1, 3);
-
-    PE32.WriteName(".data");
-    WriteReloc(0, 2, 3);
-
-    PE32.WriteName(".edata");
-    WriteReloc(0, 3, 3);
-
-    PE32.WriteName(".idata");
-    WriteReloc(0, 4, 3);
-
-    PE32.WriteName(".bss");
-    WriteReloc(0, 5, 3);
-
-    WR.Write32LE(4);
-
-    WR.Close
-END write;
-
-
-END MSCOFF.

programs/develop/oberon07/source/MSP430RTL.ob07

@@ -1,671 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2019-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE MSP430RTL;
-
-
-CONST
-
-    _mul*      =  0;
-    _divmod*   =  1;
-    _lsl*      =  2;
-    _asr*      =  3;
-    _ror*      =  4;
-    _lsr*      =  5;
-    _in*       =  6;
-    _in2*      =  7;
-    _set1*     =  8;
-    _incl*     =  9;
-    _excl*     = 10;
-    _move*     = 11;
-    _set*      = 12;
-    _arrcpy*   = 13;
-    _rot*      = 14;
-    _strcmp*   = 15;
-    _error*    = 16;
-    _is*       = 17;
-    _guard*    = 18;
-    _guardrec* = 19;
-    _length*   = 20;
-    _new*      = 21;
-
-
-    HP* = 15;
-
-    LenIV* = 32;
-
-    iv          = 10000H - LenIV * 2;
-    bsl         = iv - 2;
-    sp          = bsl - 2;
-    empty_proc* = sp - 2;
-    bits        = empty_proc - 272;
-    bits_offs   = bits - 32;
-    DataSize*   = iv - bits_offs;
-    types       = bits_offs - 2;
-
-    IntVectorSize* = LenIV * 2 + DataSize;
-
-    VarSize*  = 4;
-
-    StkReserve* = 40;
-
-    trap = 2;
-
-
-TYPE
-
-    EMITPROC = PROCEDURE (n: INTEGER);
-
-
-VAR
-
-    ram*: INTEGER;
-
-    rtl*: ARRAY 22 OF
-              RECORD
-                  label*: INTEGER;
-                  used:   BOOLEAN
-              END;
-
-    Label, Word, Call: EMITPROC;
-
-
-PROCEDURE Gen*;
-
-
-    PROCEDURE Word1 (word: INTEGER);
-    BEGIN
-        Word(word)
-    END Word1;
-
-
-    PROCEDURE Word2 (word1, word2: INTEGER);
-    BEGIN
-        Word1(word1);
-        Word1(word2)
-    END Word2;
-
-
-    PROCEDURE Word3 (word1, word2, word3: INTEGER);
-    BEGIN
-        Word1(word1);
-        Word1(word2);
-        Word1(word3)
-    END Word3;
-
-
-BEGIN
-    (* _lsl (n, x: INTEGER): INTEGER *)
-    IF rtl[_lsl].used THEN
-        Label(rtl[_lsl].label);
-        Word2(4115H, 2);              (*  MOV  2(SP), R5; R5 <- n  *)
-        Word2(4114H, 4);              (*  MOV  4(SP), R4; R4 <- x  *)
-        Word2(0F035H, 15);            (*  AND  #15, R5             *)
-        Word1(2400H + 3);             (*  JZ   L1                  *)
-                                      (*  L2:                      *)
-        Word1(5404H);                 (*  ADD  R4, R4              *)
-        Word1(8315H);                 (*  SUB  #1, R5              *)
-        Word1(2000H + 400H - 3);      (*  JNZ  L2                  *)
-                                      (*  L1:                      *)
-        Word1(4130H)                  (*  RET                      *)
-    END;
-
-    (* _asr (n, x: INTEGER): INTEGER *)
-    IF rtl[_asr].used THEN
-        Label(rtl[_asr].label);
-        Word2(4115H, 2);              (*  MOV  2(SP), R5; R5 <- n  *)
-        Word2(4114H, 4);              (*  MOV  4(SP), R4; R4 <- x  *)
-        Word2(0F035H, 15);            (*  AND  #15, R5             *)
-        Word1(2400H + 3);             (*  JZ   L1                  *)
-                                      (*  L2:                      *)
-        Word1(1104H);                 (*  RRA  R4                  *)
-        Word1(8315H);                 (*  SUB  #1, R5              *)
-        Word1(2000H + 400H - 3);      (*  JNZ  L2                  *)
-                                      (*  L1:                      *)
-        Word1(4130H)                  (*  RET                      *)
-    END;
-
-    (* _ror (n, x: INTEGER): INTEGER *)
-    IF rtl[_ror].used THEN
-        Label(rtl[_ror].label);
-        Word2(4115H, 2);              (*  MOV  2(SP), R5; R5 <- n  *)
-        Word2(4114H, 4);              (*  MOV  4(SP), R4; R4 <- x  *)
-        Word2(0F035H, 15);            (*  AND  #15, R5             *)
-        Word1(2400H + 5);             (*  JZ   L1                  *)
-        Word1(4406H);                 (*  MOV  R4, R6              *)
-                                      (*  L2:                      *)
-        Word1(1006H);                 (*  RRC  R6                  *)
-        Word1(1004H);                 (*  RRC  R4                  *)
-        Word1(8315H);                 (*  SUB  #1, R5              *)
-        Word1(2000H + 400H - 4);      (*  JNZ  L2                  *)
-                                      (*  L1:                      *)
-        Word1(4130H)                  (*  RET                      *)
-    END;
-
-    (* _lsr (n, x: INTEGER): INTEGER *)
-    IF rtl[_lsr].used THEN
-        Label(rtl[_lsr].label);
-        Word2(4115H, 2);              (*  MOV  2(SP), R5; R5 <- n  *)
-        Word2(4114H, 4);              (*  MOV  4(SP), R4; R4 <- x  *)
-        Word2(0F035H, 15);            (*  AND  #15, R5             *)
-        Word1(2400H + 4);             (*  JZ   L1                  *)
-                                      (*  L2:                      *)
-        Word1(0C312H);                (*  BIC  #1, SR              *)
-        Word1(1004H);                 (*  RRC  R4                  *)
-        Word1(8315H);                 (*  SUB  #1, R5              *)
-        Word1(2000H + 400H - 4);      (*  JNZ  L2                  *)
-                                      (*  L1:                      *)
-        Word1(4130H)                  (*  RET                      *)
-    END;
-
-    (* _set (b, a: INTEGER): SET *)
-    IF rtl[_set].used THEN
-        Label(rtl[_set].label);
-        Word2(4114H, 2);              (*  MOV  2(SP), R4; R4 <- b  *)
-        Word2(4115H, 4);              (*  MOV  4(SP), R5; R5 <- a  *)
-        Word1(9504H);                 (*  CMP  R5, R4              *)
-        Word1(3800H + 24);            (*  JL   L1                  *)
-        Word2(9035H, 16);             (*  CMP  #16, R5             *)
-        Word1(3400H + 21);            (*  JGE  L1                  *)
-        Word1(9304H);                 (*  CMP  #0, R4              *)
-        Word1(3800H + 19);            (*  JL   L1                  *)
-        Word2(9034H, 16);             (*  CMP  #16, R4             *)
-        Word1(3800H + 2);             (*  JL   L2                  *)
-        Word2(4034H, 15);             (*  MOV  #15, R4             *)
-                                      (*  L2:                      *)
-        Word1(9305H);                 (*  CMP  #0, R5              *)
-        Word1(3400H + 1);             (*  JGE  L3                  *)
-        Word1(4305H);                 (*  MOV  #0, R5              *)
-                                      (*  L3:                      *)
-        Word1(8504H);                 (*  SUB  R5, R4              *)
-        Word1(5404H);                 (*  ADD  R4, R4              *)
-        Word2(5034H, bits_offs);      (*  ADD  bits_offs, R4       *)
-        Word1(4424H);                 (*  MOV  @R4, R4             *)
-        Word1(5505H);                 (*  ADD  R5, R5              *)
-        Word1(5405H);                 (*  ADD  R4, R5              *)
-        Word2(5035H, bits);           (*  ADD  bits, R5            *)
-        Word1(4524H);                 (*  MOV  @R5, R4             *)
-        Word1(4130H);                 (*  RET                      *)
-                                      (*  L1:                      *)
-        Word1(4304H);                 (*  MOV  #0, R4              *)
-        Word1(4130H)                  (*  RET                      *)
-    END;
-
-    (* _set1 (a: INTEGER): SET *)
-    IF rtl[_set1].used THEN
-        Label(rtl[_set1].label);
-        Word2(4114H, 2);              (*  MOV  2(SP), R4; R4 <- a  *)
-        Word2(0B034H, 0FFF0H);        (*  BIT  #0FFF0H, R4         *)
-        Word1(2000H + 5);             (*  JNZ  L1                  *)
-        Word1(5404H);                 (*  ADD  R4, R4              *)
-        Word2(5034H, bits);           (*  ADD  bits, R4            *)
-        Word1(4424H);                 (*  MOV  @R4, R4             *)
-        Word1(4130H);                 (*  RET                      *)
-                                      (*  L1:                      *)
-        Word1(4304H);                 (*  MOV  #0, R4              *)
-        Word1(4130H)                  (*  RET                      *)
-    END;
-
-    (* _in2 (i, s: INTEGER): BOOLEAN *)
-    IF rtl[_in2].used THEN
-        Label(rtl[_in2].label);
-        Word2(4114H, 2);               (*  MOV  2(SP), R4; R4 <- i  *)
-        Word1(5404H);                  (*  ADD  R4, R4              *)
-        Word2(5034H, bits);            (*  ADD  bits, R4            *)
-        Word1(4424H);                  (*  MOV  @R4, R4             *)
-        Word2(0F114H, 4);              (*  AND  4(SP), R4           *)
-        Word1(2400H + 1);              (*  JZ   L1                  *)
-        Word1(4314H);                  (*  MOV  #1, R4              *)
-                                       (*  L1:                      *)
-        Word1(4130H)                   (*  RET                      *)
-    END;
-
-    (* _in (s, i: INTEGER): BOOLEAN *)
-    IF rtl[_in].used THEN
-        Label(rtl[_in].label);
-        Word2(4114H, 4);               (*  MOV  4(SP), R4; R4 <- i  *)
-        Word2(0B034H, 0FFF0H);         (*  BIT  #0FFF0H, R4         *)
-        Word1(2000H + 9);              (*  JNZ  L2                  *)
-        Word1(5404H);                  (*  ADD  R4, R4              *)
-        Word2(5034H, bits);            (*  ADD  bits, R4            *)
-        Word1(4424H);                  (*  MOV  @R4, R4             *)
-        Word2(0F114H, 2);              (*  AND  2(SP), R4           *)
-        Word1(2400H + 3);              (*  JZ   L1                  *)
-        Word1(4314H);                  (*  MOV  #1, R4              *)
-        Word1(4130H);                  (*  RET                      *)
-                                       (*  L2:                      *)
-        Word1(4304H);                  (*  MOV  #0, R4              *)
-                                       (*  L1:                      *)
-        Word1(4130H)                   (*  RET                      *)
-    END;
-
-    (* _incl (VAR s: SET; i: INTEGER) *)
-    IF rtl[_incl].used THEN
-        Label(rtl[_incl].label);
-        Word2(4114H, 4);          (*  MOV  4(SP), R4; R4 <- i  *)
-        Word2(0B034H, 0FFF0H);    (*  BIT  #0FFF0H, R4         *)
-        Word1(2000H + 8);         (*  JNZ  L1                  *)
-        Word1(5404H);             (*  ADD  R4, R4              *)
-        Word2(5034H, bits);       (*  ADD  bits, R4            *)
-        Word1(4424H);             (*  MOV  @R4, R4             *)
-        Word2(4115H, 2);          (*  MOV  2(SP), R5; R5 <- @s *)
-        Word2(0D485H, 0);         (*  BIS  R4, 0(R5)           *)
-                                  (*  L1:                      *)
-        Word1(4130H)              (*  RET                      *)
-    END;
-
-    (* _excl (VAR s: SET; i: INTEGER) *)
-    IF rtl[_excl].used THEN
-        Label(rtl[_excl].label);
-        Word2(4114H, 4);          (*  MOV  4(SP), R4; R4 <- i  *)
-        Word2(0B034H, 0FFF0H);    (*  BIT  #0FFF0H, R4         *)
-        Word1(2000H + 8);         (*  JNZ  L1                  *)
-        Word1(5404H);             (*  ADD  R4, R4              *)
-        Word2(5034H, bits);       (*  ADD  bits, R4            *)
-        Word1(4424H);             (*  MOV  @R4, R4             *)
-        Word2(4115H, 2);          (*  MOV  2(SP), R5; R5 <- @s *)
-        Word2(0C485H, 0);         (*  BIC  R4, 0(R5)           *)
-                                  (*  L1:                      *)
-        Word1(4130H)              (*  RET                      *)
-    END;
-
-    (* _rot (len, adr: INTEGER) *)
-    IF rtl[_rot].used THEN
-        Label(rtl[_rot].label);
-        Word2(4114H, 2);              (*  MOV    2(SP), R4; R4 <- len   *)
-        Word2(4115H, 4);              (*  MOV    4(SP), R5; R5 <- adr   *)
-        Word1(8314H);                 (*  SUB    #1, R4                 *)
-        Word1(5404H);                 (*  ADD    R4, R4                 *)
-        Word1(1225H);                 (*  PUSH   @R5                    *)
-        Word1(4406H);                 (*  MOV    R4, R6                 *)
-                                      (*  L1:                           *)
-        Word3(4595H, 2, 0);           (*  MOV    2(R5), 0(R5)           *)
-        Word1(5325H);                 (*  ADD    #2, R5                 *)
-        Word1(8326H);                 (*  SUB    #2, R6                 *)
-        Word1(2000H + 400H - 6);      (*  JNZ    L1                     *)
-        Word2(41B5H, 0);              (*  MOV    @SP+, 0(R5)            *)
-        Word1(4130H)                  (*  RET                           *)
-    END;
-
-    (* _divmod (b, a: INTEGER): INTEGER (* res -> R4, mod -> R5 *) *)
-    IF rtl[_divmod].used THEN
-        Label(rtl[_divmod].label);
-        Word2(4115H, 4);              (*  MOV  4(SP), R5; R5 <- a  *)
-        Word1(4304H);                 (*  MOV  #0, R4              *)
-                                      (*  L1:                      *)
-        Word2(4116H, 2);              (*  MOV  2(SP), R6; R6 <- b  *)
-        Word1(9605H);                 (*  CMP  R6, R5              *)
-        Word1(3800H + 17);            (*  JL   L3                  *)
-        Word1(4327H);                 (*  MOV  #2, R7              *)
-        Word1(5606H);                 (*  ADD  R6, R6              *)
-                                      (*  L4:                      *)
-        Word1(9306H);                 (*  CMP  #0, R6              *)
-        Word1(2400H + 6);             (*  JZ   L2                  *)
-        Word1(3800H + 5);             (*  JL   L2                  *)
-        Word1(9605H);                 (*  CMP  R6, R5              *)
-        Word1(3800H + 3);             (*  JL   L2                  *)
-        Word1(5606H);                 (*  ADD  R6, R6              *)
-        Word1(5707H);                 (*  ADD  R7, R7              *)
-        Word1(3C00H + 400H - 8);      (*  JMP  L4                  *)
-                                      (*  L2:                      *)
-        Word1(0C312H);                (*  BIC  #1, SR              *)
-        Word1(1006H);                 (*  RRC  R6                  *)
-        Word1(0C312H);                (*  BIC  #1, SR              *)
-        Word1(1007H);                 (*  RRC  R7                  *)
-        Word1(8605H);                 (*  SUB  R6, R5              *)
-        Word1(5704H);                 (*  ADD  R7, R4              *)
-        Word1(3C00H + 400H - 21);     (*  JMP  L1                  *)
-                                      (*  L3:                      *)
-        (*----------- (a < 0) --------------*)
-                                      (*  L1:                      *)
-        Word1(9305H);                 (*  CMP  #0, R5              *)
-        Word1(3400H + 23);            (*  JGE  L3                  *)
-        Word2(4116H, 2);              (*  MOV  2(SP), R6; R6 <- b  *)
-        Word1(4327H);                 (*  MOV  #2, R7              *)
-        Word1(5606H);                 (*  ADD  R6, R6              *)
-        Word1(0E335H);                (*  XOR  #-1, R5             *)
-        Word1(5315H);                 (*  ADD  #1,  R5             *)
-                                      (*  L4:                      *)
-        Word1(9306H);                 (*  CMP  #0, R6              *)
-        Word1(2400H + 6);             (*  JZ   L2                  *)
-        Word1(3800H + 5);             (*  JL   L2                  *)
-        Word1(9605H);                 (*  CMP  R6, R5              *)
-        Word1(3800H + 3);             (*  JL   L2                  *)
-        Word1(5606H);                 (*  ADD  R6, R6              *)
-        Word1(5707H);                 (*  ADD  R7, R7              *)
-        Word1(3C00H + 400H - 8);      (*  JMP  L4                  *)
-                                      (*  L2:                      *)
-        Word1(0E335H);                (*  XOR  #-1, R5             *)
-        Word1(5315H);                 (*  ADD  #1,  R5             *)
-        Word1(0C312H);                (*  BIC  #1, SR              *)
-        Word1(1006H);                 (*  RRC  R6                  *)
-        Word1(0C312H);                (*  BIC  #1, SR              *)
-        Word1(1007H);                 (*  RRC  R7                  *)
-        Word1(5605H);                 (*  ADD  R6, R5              *)
-        Word1(8704H);                 (*  SUB  R7, R4              *)
-        Word1(3C00H + 400H - 25);     (*  JMP  L1                  *)
-                                      (*  L3:                      *)
-        Word1(4130H)                  (*  RET                      *)
-    END;
-
-    (* _mul (a, b: INTEGER): INTEGER *)
-    IF rtl[_mul].used THEN
-        Label(rtl[_mul].label);
-        Word2(4115H, 2);              (*  MOV  2(SP), R5; R5 <- a  *)
-        Word2(4116H, 4);              (*  MOV  4(SP), R6; R6 <- b  *)
-        Word1(4304H);                 (*  MOV  #0, R4; res := 0    *)
-        Word1(9306H);                 (*  CMP  #0, R6              *)
-        Word1(2400H + 7);             (*  JZ   L1                  *)
-                                      (*  L2:                      *)
-        Word1(0B316H);                (*  BIT  #1, R6              *)
-        Word1(2400H + 1);             (*  JZ   L3                  *)
-        Word1(5504H);                 (*  ADD  R5, R4              *)
-                                      (*  L3:                      *)
-        Word1(5505H);                 (*  ADD  R5, R5              *)
-        Word1(0C312H);                (*  BIC  #1, SR              *)
-        Word1(1006H);                 (*  RRC  R6                  *)
-        Word1(2000H + 400H - 7);      (*  JNZ  L2                  *)
-                                      (*  L1:                      *)
-        Word1(4130H)                  (*  RET                      *)
-    END;
-
-    (* _error (modNum, modName, err, line: INTEGER) *)
-    IF rtl[_error].used THEN
-        Label(rtl[_error].label);
-        Word1(5321H);          (*  ADD   #2, SP             *)
-        Word1(4134H);          (*  POP   R4; R4 <- modNum   *)
-        Word1(4135H);          (*  POP   R5; R5 <- modName  *)
-        Word1(4136H);          (*  POP   R6; R6 <- err      *)
-        Word1(4137H);          (*  POP   R7; R7 <- line     *)
-        Word2(4211H, sp);      (*  MOV   sp(SR), SP                   *)
-        Word1(1207H);          (*  PUSH  R7                           *)
-        Word1(1206H);          (*  PUSH  R6                           *)
-        Word1(1205H);          (*  PUSH  R5                           *)
-        Word1(1204H);          (*  PUSH  R4                           *)
-        Word2(4214H, sp);      (*  MOV   sp(SR), R4                   *)
-        Word2(1294H, trap);    (*  CALL  trap(R4)                     *)
-        Word2(04032H, 0F0H)    (*  MOV   CPUOFF+OSCOFF+SCG0+SCG1, SR  *)
-    END;
-
-    (* _new (t, size: INTEGER; VAR ptr: INTEGER) *)
-    IF rtl[_new].used THEN
-        Label(rtl[_new].label);
-        Word1(1202H);                  (*  PUSH SR               *)
-        Word1(4302H);                  (*  MOV  #0, SR           *)
-        Word1(4303H);                  (*  NOP                   *)
-        Word1(4104H);                  (*  MOV  SP, R4           *)
-        Word2(8034H, StkReserve);      (*  SUB  #StkReserve, R4  *)
-        Word1(4005H + 100H * HP);      (*  MOV  HP, R5           *)
-        Word2(5115H, 6);               (*  ADD  6(SP), R5        *)
-        Word1(9504H);                  (*  CMP  R5, R4           *)
-        Word2(4114H, 8);               (*  MOV  8(SP), R4        *)
-        Word1(3800H + 12);             (*  JL   L1               *)
-        Word3(4190H + HP, 4, 0);       (*  MOV  4(SP), 0(HP)     *)
-        Word1(5320H + HP);             (*  ADD  #2, HP           *)
-        Word2(4084H + 100H * HP, 0);   (*  MOV  HP, 0(R4)        *)
-                                       (*  L3                    *)
-        Word2(4380H + HP, 0);          (*  MOV  #0, 0(HP)        *)
-        Word1(5320H + HP);             (*  ADD  #2, HP           *)
-        Word1(9500H + HP);             (*  CMP  R5, HP           *)
-        Word1(3800H + 400H - 5);       (*  JL   L3               *)
-        Word1(3C00H + 2);              (*  JMP  L2               *)
-                                       (*  L1                    *)
-        Word2(4384H, 0);               (*  MOV  #0, 0(R4)        *)
-                                       (*  L2                    *)
-        Word1(1300H)                   (*  RETI                  *)
-    END;
-
-    (* _guardrec (t0, t1: INTEGER): INTEGER *)
-    IF rtl[_guardrec].used THEN
-        Label(rtl[_guardrec].label);
-        Word2(4114H, 2);              (*  MOV  2(SP), R4; R4 <- t0  *)
-        Word2(4115H, 4);              (*  MOV  4(SP), R5; R5 <- t1  *)
-        Word2(4036H, types);          (*  MOV  #types, R6           *)
-                                      (*  L3:                       *)
-        Word1(9305H);                 (*  CMP  #0, R5               *)
-        Word1(2400H + 8);             (*  JZ   L1                   *)
-        Word1(9405H);                 (*  CMP  R4, R5               *)
-        Word1(2400H + 10);            (*  JZ   L2                   *)
-        Word1(5505H);                 (*  ADD  R5, R5               *)
-        Word1(0E335H);                (*  XOR  #-1, R5              *)
-        Word1(5315H);                 (*  ADD  #1, R5               *)
-        Word1(5605H);                 (*  ADD  R6, R5               *)
-        Word1(4525H);                 (*  MOV  @R5, R5              *)
-        Word1(3C00H + 400H - 10);     (*  JMP  L3                   *)
-                                      (*  L1:                       *)
-        Word1(9405H);                 (*  CMP  R4, R5               *)
-        Word1(2400H + 2);             (*  JZ   L2                   *)
-        Word1(4304H);                 (*  MOV  #0, R4               *)
-        Word1(4130H);                 (*  RET                       *)
-                                      (*  L2:                       *)
-        Word1(4314H);                 (*  MOV  #1, R4               *)
-        Word1(4130H)                  (*  RET                       *)
-    END;
-
-    (* _is (t, p: INTEGER): INTEGER *)
-    IF rtl[_is].used THEN
-        Label(rtl[_is].label);
-        Word2(4114H, 4);             (*  MOV  4(SP), R4; R4 <- p  *)
-        Word2(4115H, 2);             (*  MOV  2(SP), R5; R5 <- t  *)
-        Word1(9304H);                (*  TST  R4                  *)
-        Word1(2400H + 2);            (*  JZ   L                   *)
-        Word2(4414H, -2);            (*  MOV  -2(R4), R4          *)
-                                     (*  L:                       *)
-        Word1(1204H);                (*  PUSH R4                  *)
-        Word1(1205H);                (*  PUSH R5                  *)
-        Call(rtl[_guardrec].label);  (*  CALL _guardrec           *)
-        Word1(5221H);                (*  ADD  #4, SP              *)
-        Word1(4130H)                 (*  RET                      *)
-    END;
-
-    (* _guard (t, p: INTEGER): INTEGER *)
-    IF rtl[_guard].used THEN
-        Label(rtl[_guard].label);
-        Word2(4115H, 4);             (*  MOV  4(SP), R5; R5 <- p  *)
-        Word1(4314H);                (*  MOV  #1, R4              *)
-        Word1(4525H);                (*  MOV  @R5, R5             *)
-        Word1(9305H);                (*  TST  R5                  *)
-        Word1(2400H + 9);            (*  JZ   L                   *)
-        Word2(4515H, -2);            (*  MOV  -2(R5), R5          *)
-        Word2(4114H, 2);             (*  MOV  2(SP), R4; R4 <- t  *)
-        Word1(1205H);                (*  PUSH R5                  *)
-        Word1(1204H);                (*  PUSH R4                  *)
-        Call(rtl[_guardrec].label);  (*  CALL _guardrec           *)
-        Word1(5221H);                (*  ADD  #4, SP              *)
-                                     (*  L:                       *)
-        Word1(4130H)                 (*  RET                      *)
-    END;
-
-    (* _move (bytes, dest, source: INTEGER) *)
-    IF rtl[_move].used THEN
-        Label(rtl[_move].label);
-        Word2(4116H, 2);              (*  MOV    2(SP), R6; R6 <- bytes   *)
-        Word2(4117H, 4);              (*  MOV    4(SP), R7; R7 <- dest    *)
-        Word2(4115H, 6);              (*  MOV    6(SP), R5; R5 <- source  *)
-        Word1(9306H);                 (*  CMP    #0, R6                   *)
-        Word1(3800H + 6);             (*  JL     L1                       *)
-        Word1(2400H + 5);             (*  JZ     L1                       *)
-                                      (*  L2:                             *)
-        Word2(45F7H, 0);              (*  MOV.B  @R5+, 0(R7)              *)
-        Word1(5317H);                 (*  ADD    #1, R7                   *)
-        Word1(8316H);                 (*  SUB    #1, R6                   *)
-        Word1(2000H + 400H - 5);      (*  JNZ    L2                       *)
-                                      (*  L1:                             *)
-        Word1(4130H)                  (*  RET                             *)
-    END;
-
-    (* _arrcpy (base_size, len_dst, dst, len_src, src: INTEGER) *)
-    IF rtl[_arrcpy].used THEN
-        Label(rtl[_arrcpy].label);
-        Word3(9191H, 8, 4);          (*  CMP  8(SP), 4(SP) *)
-        Word1(3800H + 18);           (*  JL   L1           *)
-        Word2(1211H, 12);            (*  PUSH 12(SP)       *)
-        Word2(1211H, 10);            (*  PUSH 10(SP)       *)
-        Word2(1211H, 14);            (*  PUSH 14(SP)       *)
-        Word2(1211H, 10);            (*  PUSH 10(SP)       *)
-        Call(rtl[_mul].label);       (*  CALL _mul         *)
-        Word1(5221H);                (*  ADD  #4, SP       *)
-        Word1(1204H);                (*  PUSH R4           *)
-        Call(rtl[_move].label);      (*  CALL _move        *)
-        Word2(5031H, 6);             (*  ADD  #6, SP       *)
-        Word1(4314H);                (*  MOV  #1, R4       *)
-        Word1(4130H);                (*  RET               *)
-                                     (*  L1                *)
-        Word1(4304H);                (*  MOV  #0, R4       *)
-        Word1(4130H)                 (*  RET               *)
-    END;
-
-    (* _length (len, str: INTEGER): INTEGER *)
-    IF rtl[_length].used THEN
-        Label(rtl[_length].label);
-        Word2(4116H, 2);              (*  MOV    2(SP), R6; R6 <- len  *)
-        Word2(4117H, 4);              (*  MOV    4(SP), R7; R7 <- str  *)
-        Word1(4304H);                 (*  MOV    #0, R4; res := 0      *)
-                                      (*  L2:                          *)
-        Word1(4775H);                 (*  MOV.B  @R7+, R5              *)
-        Word1(9305H);                 (*  CMP    #0, R5                *)
-        Word1(2400H + 3);             (*  JZ     L1                    *)
-        Word1(5314H);                 (*  ADD    #1, R4                *)
-        Word1(8316H);                 (*  SUB    #1, R6                *)
-        Word1(2000H + 400H - 6);      (*  JNZ    L2                    *)
-                                      (*  L1:                          *)
-        Word1(4130H)                  (*  RET                          *)
-    END;
-
-    (* _strcmp (op, len2, str2, len1, str1: INTEGER): BOOLEAN *)
-    IF rtl[_strcmp].used THEN
-        Label(rtl[_strcmp].label);
-        Word2(4116H, 4);            (*  MOV    4(SP), R6; R6 <- len2   *)
-        Word2(4117H, 8);            (*  MOV    8(SP), R7; R7 <- len1   *)
-        Word1(9607H);               (*  CMP    R6, R7                  *)
-        Word1(3400H + 1);           (*  JGE    L5                      *)
-        Word1(4706H);               (*  MOV    R7, R6                  *)
-                                    (*  L5:                            *)
-        Word1(1206H);               (*  PUSH   R6                      *)
-        Word2(4116H, 12);           (*  MOV    12(SP), R6; R6 <- str1  *)
-        Word2(4117H, 8);            (*  MOV    8(SP), R7; R7 <- str2   *)
-                                    (*  L3:                            *)
-        Word2(9381H, 0);            (*  CMP    #0, 0(SP)               *)
-        Word1(2400H + 11);          (*  JZ     L1                      *)
-        Word1(4674H);               (*  MOV.B  @R6+, R4                *)
-        Word1(4775H);               (*  MOV.B  @R7+, R5                *)
-        Word2(8391H, 0);            (*  SUB    #1, 0(SP)               *)
-        Word1(9405H);               (*  CMP    R4, R5                  *)
-        Word1(2400H + 2);           (*  JZ     L2                      *)
-        Word1(8504H);               (*  SUB    R5, R4                  *)
-        Word1(3C00H + 5);           (*  JMP    L4                      *)
-                                    (*  L2:                            *)
-        Word1(9304H);               (*  CMP    #0, R4                  *)
-        Word1(2000H + 400H - 13);   (*  JNZ    L3                      *)
-        Word1(3C00H + 2);           (*  JMP    L4                      *)
-                                    (*  L1:                            *)
-        Word2(4034H, 8000H);        (*  MOV    #8000H, R4              *)
-                                    (*  L4:                            *)
-        Word1(5321H);               (*  ADD    #2, SP                  *)
-
-        Word2(9034H, 8000H);        (*  CMP    #8000H, R4              *)
-        Word1(2000H + 18);          (*  JNZ    L6                      *)
-        Word2(4116H, 4);            (*  MOV    4(SP), R6; R6 <- len2   *)
-        Word2(4117H, 8);            (*  MOV    8(SP), R7; R7 <- len1   *)
-        Word1(9607H);               (*  CMP    R6, R7                  *)
-        Word1(2400H + 11);          (*  JZ     L7                      *)
-        Word1(3800H + 4);           (*  JL     L8                      *)
-        Word2(5116H, 10);           (*  ADD    10(SP), R6              *)
-        Word1(4664H);               (*  MOV.B  @R6, R4                 *)
-        Word1(3C00H + 7);           (*  JMP    L6                      *)
-                                    (*  L8:                            *)
-        Word2(5117H, 6);            (*  ADD    6(SP), R7               *)
-        Word1(4764H);               (*  MOV.B  @R7, R4                 *)
-        Word1(0E334H);              (*  XOR    #-1, R4                 *)
-        Word1(5314H);               (*  ADD    #1, R4                  *)
-        Word1(3C00H + 1);           (*  JMP    L6                      *)
-                                    (*  L7:                            *)
-        Word1(4304H);               (*  MOV    #0, R4                  *)
-                                    (*  L6:                            *)
-
-        Word2(5110H, 2);            (*  ADD  2(SP), PC; PC <- PC + op  *)
-
-        Word1(9304H);               (*  CMP  #0, R4  *)
-        Word1(4314H);               (*  MOV  #1, R4  *)
-        Word1(2400H + 1);           (*  JZ   L       *)
-        Word1(4304H);               (*  MOV  #0, R4  *)
-                                    (*  L            *)
-        Word1(4130H);               (*  RET          *)
-        Word1(4303H);               (*  NOP          *)
-
-        Word1(9304H);               (*  CMP  #0, R4  *)
-        Word1(4314H);               (*  MOV  #1, R4  *)
-        Word1(2000H + 1);           (*  JNZ  L       *)
-        Word1(4304H);               (*  MOV  #0, R4  *)
-                                    (*  L            *)
-        Word1(4130H);               (*  RET          *)
-        Word1(4303H);               (*  NOP          *)
-
-        Word1(9304H);               (*  CMP  #0, R4  *)
-        Word1(4314H);               (*  MOV  #1, R4  *)
-        Word1(3800H + 1);           (*  JL   L       *)
-        Word1(4304H);               (*  MOV  #0, R4  *)
-                                    (*  L            *)
-        Word1(4130H);               (*  RET          *)
-        Word1(4303H);               (*  NOP          *)
-
-        Word1(9304H);               (*  CMP  #0, R4  *)
-        Word1(4314H);               (*  MOV  #1, R4  *)
-        Word1(3800H + 2);           (*  JL   L       *)
-        Word1(2400H + 1);           (*  JZ   L       *)
-        Word1(4304H);               (*  MOV  #0, R4  *)
-                                    (*  L            *)
-        Word1(4130H);               (*  RET          *)
-
-        Word1(9304H);               (*  CMP  #0, R4  *)
-        Word1(4304H);               (*  MOV  #0, R4  *)
-        Word1(3800H + 2);           (*  JL   L       *)
-        Word1(2400H + 1);           (*  JZ   L       *)
-        Word1(4314H);               (*  MOV  #1, R4  *)
-                                    (*  L            *)
-        Word1(4130H);               (*  RET          *)
-
-        Word1(9304H);               (*  CMP  #0, R4  *)
-        Word1(4314H);               (*  MOV  #1, R4  *)
-        Word1(3400H + 1);           (*  JGE  L       *)
-        Word1(4304H);               (*  MOV  #0, R4  *)
-                                    (*  L            *)
-        Word1(4130H)                (*  RET          *)
-    END
-
-END Gen;
-
-
-PROCEDURE Set* (idx, label: INTEGER);
-BEGIN
-    rtl[idx].label := label;
-    rtl[idx].used  := FALSE
-END Set;
-
-
-PROCEDURE Used* (idx: INTEGER);
-BEGIN
-    rtl[idx].used := TRUE;
-    IF (idx = _guard) OR (idx = _is) THEN
-        rtl[_guardrec].used := TRUE
-    ELSIF idx = _arrcpy THEN
-        rtl[_move].used := TRUE;
-        rtl[_mul].used  := TRUE
-    END
-END Used;
-
-
-PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC);
-BEGIN
-    Label := pLabel;
-    Word  := pWord;
-    Call  := pCall;
-    ram   := 200H;
-END Init;
-
-
-END MSP430RTL.

programs/develop/oberon07/source/PATHS.ob07

@@ -1,151 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE PATHS;
-
-IMPORT STRINGS, UTILS;
-
-
-CONST
-
-    slash = UTILS.slash;
-
-    PATHLEN = 2048;
-
-
-TYPE
-
-    PATH* = ARRAY PATHLEN OF CHAR;
-
-
-PROCEDURE split* (fname: ARRAY OF CHAR; VAR path, name, ext: ARRAY OF CHAR);
-VAR
-    pos1, pos2, len: INTEGER;
-
-BEGIN
-    len := LENGTH(fname);
-    pos1 := len - 1;
-    pos2 := pos1;
-    STRINGS.search(fname, pos1, slash, FALSE);
-    STRINGS.search(fname, pos2,   ".", FALSE);
-
-    path := fname;
-    path[pos1 + 1] := 0X;
-
-    IF (pos2 = -1) OR (pos2 < pos1) THEN
-        pos2 := len
-    END;
-
-    INC(pos1);
-
-    STRINGS.copy(fname, name, pos1, 0, pos2 - pos1);
-    name[pos2 - pos1] := 0X;
-    STRINGS.copy(fname, ext, pos2, 0, len - pos2);
-    ext[len - pos2] := 0X
-END split;
-
-
-PROCEDURE RelPath* (absolute, relative: ARRAY OF CHAR; VAR res: ARRAY OF CHAR);
-VAR
-    i, j: INTEGER;
-    error: BOOLEAN;
-
-BEGIN
-    COPY(absolute, res);
-    i := LENGTH(res) - 1;
-    WHILE (i >= 0) & (res[i] # slash) DO
-        DEC(i)
-    END;
-
-    INC(i);
-    res[i] := 0X;
-
-    error := FALSE;
-    j := 0;
-    WHILE (relative[j] = ".") & (relative[j + 1] = slash) DO
-        INC(j, 2)
-    ELSIF relative[j] = slash DO
-        INC(j)
-    END;
-
-    WHILE ~error & (relative[j] # 0X) DO
-        IF (relative[j] = ".") & (relative[j + 1] = ".") & (relative[j + 2] = slash) & (i > 0) & (res[i - 1] = slash) THEN
-            DEC(i, 2);
-            WHILE (i >= 0) & (res[i] # slash) DO
-                DEC(i)
-            END;
-            IF i < 0 THEN
-                error := TRUE
-            ELSE
-                INC(i);
-                INC(j, 3)
-            END
-        ELSE
-            res[i] := relative[j];
-            INC(i);
-            INC(j)
-        END
-    END;
-
-    IF error THEN
-        COPY(relative, res)
-    ELSE
-        res[i] := 0X
-    END
-
-END RelPath;
-
-
-PROCEDURE DelSlashes* (VAR path: ARRAY OF CHAR);
-VAR
-    i, j, k: INTEGER;
-    c: CHAR;
-
-BEGIN
-    i := 0;
-    j := 0;
-    k := 0;
-    REPEAT
-        c := path[j];
-        INC(j);
-        IF c = slash THEN
-            INC(k)
-        ELSE
-            k := 0
-        END;
-        IF k <= 1 THEN
-            path[i] := c;
-            INC(i)
-        END
-    UNTIL c = 0X;
-
-    i := 0;
-    j := 0;
-    REPEAT
-        c := path[j];
-        INC(j);
-        path[i] := c;
-        INC(i);
-        IF (c = slash) & (path[j] = ".") & (path[j + 1] = slash) THEN
-            INC(j, 2)
-        END
-    UNTIL c = 0X
-END DelSlashes;
-
-
-PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
-    RETURN UTILS.isRelative(path)
-END isRelative;
-
-
-PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
-BEGIN
-    UTILS.GetCurrentDirectory(path)
-END GetCurrentDirectory;
-
-
-END PATHS.

programs/develop/oberon07/source/PE32.ob07

@@ -1,695 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2020, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE PE32;
-
-IMPORT BIN, LISTS, UTILS, WR := WRITER, CHL := CHUNKLISTS;
-
-
-CONST
-
-    SIZE_OF_DWORD = 4;
-    SIZE_OF_WORD  = 2;
-
-    SIZE_OF_IMAGE_EXPORT_DIRECTORY = 40;
-
-    IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16;
-
-    IMAGE_SIZEOF_SHORT_NAME = 8;
-
-    SIZE_OF_IMAGE_FILE_HEADER* = 20;
-
-    SIZE_OF_IMAGE_SECTION_HEADER* = 40;
-
-    (* SectionHeader.Characteristics *)
-
-    SHC_text  = 060000020H;
-    SHC_data  = 040000040H;
-    SHC_bss   = 0C0000080H;
-
-    SectionAlignment = 1000H;
-    FileAlignment    =  200H;
-
-
-TYPE
-
-    WORD  = WCHAR;
-    DWORD = INTEGER;
-
-    NAME* = ARRAY IMAGE_SIZEOF_SHORT_NAME OF CHAR;
-
-
-    IMAGE_DATA_DIRECTORY = RECORD
-
-        VirtualAddress:  DWORD;
-        Size:            DWORD
-
-    END;
-
-
-    IMAGE_OPTIONAL_HEADER = RECORD
-
-        Magic:                        WORD;
-        MajorLinkerVersion:           BYTE;
-        MinorLinkerVersion:           BYTE;
-        SizeOfCode:                   DWORD;
-        SizeOfInitializedData:        DWORD;
-        SizeOfUninitializedData:      DWORD;
-        AddressOfEntryPoint:          DWORD;
-        BaseOfCode:                   DWORD;
-        BaseOfData:                   DWORD;
-        ImageBase:                    DWORD;
-        SectionAlignment:             DWORD;
-        FileAlignment:                DWORD;
-        MajorOperatingSystemVersion:  WORD;
-        MinorOperatingSystemVersion:  WORD;
-        MajorImageVersion:            WORD;
-        MinorImageVersion:            WORD;
-        MajorSubsystemVersion:        WORD;
-        MinorSubsystemVersion:        WORD;
-        Win32VersionValue:            DWORD;
-        SizeOfImage:                  DWORD;
-        SizeOfHeaders:                DWORD;
-        CheckSum:                     DWORD;
-        Subsystem:                    WORD;
-        DllCharacteristics:           WORD;
-        SizeOfStackReserve:           DWORD;
-        SizeOfStackCommit:            DWORD;
-        SizeOfHeapReserve:            DWORD;
-        SizeOfHeapCommit:             DWORD;
-        LoaderFlags:                  DWORD;
-        NumberOfRvaAndSizes:          DWORD;
-
-        DataDirectory: ARRAY IMAGE_NUMBEROF_DIRECTORY_ENTRIES OF IMAGE_DATA_DIRECTORY
-
-    END;
-
-
-    IMAGE_FILE_HEADER* = RECORD
-
-        Machine*:               WORD;
-        NumberOfSections*:      WORD;
-        TimeDateStamp*:         DWORD;
-        PointerToSymbolTable*:  DWORD;
-        NumberOfSymbols*:       DWORD;
-        SizeOfOptionalHeader*:  WORD;
-        Characteristics*:       WORD
-
-    END;
-
-
-    IMAGE_SECTION_HEADER* = RECORD
-
-        Name*: NAME;
-
-        VirtualSize*,
-        VirtualAddress*,
-        SizeOfRawData*,
-        PointerToRawData*,
-        PointerToRelocations*,
-        PointerToLinenumbers*:   DWORD;
-
-        NumberOfRelocations*,
-        NumberOfLinenumbers*:    WORD;
-
-        Characteristics*:        DWORD
-
-    END;
-
-
-    IMAGE_EXPORT_DIRECTORY = RECORD
-
-        Characteristics:       DWORD;
-        TimeDateStamp:         DWORD;
-        MajorVersion:          WORD;
-        MinorVersion:          WORD;
-        Name,
-        Base,
-        NumberOfFunctions,
-        NumberOfNames,
-        AddressOfFunctions,
-        AddressOfNames,
-        AddressOfNameOrdinals: DWORD
-
-    END;
-
-
-    VIRTUAL_ADDR* = RECORD
-
-        Code*, Data*, Bss*, Import*: INTEGER
-
-    END;
-
-
-VAR
-
-    Signature:       ARRAY 4 OF BYTE;
-    FileHeader:      IMAGE_FILE_HEADER;
-    OptionalHeader:  IMAGE_OPTIONAL_HEADER;
-
-    msdos:           ARRAY 128 OF BYTE;
-    SectionHeaders:  ARRAY 16 OF IMAGE_SECTION_HEADER;
-    libcnt:          INTEGER;
-    SizeOfWord:      INTEGER;
-
-
-PROCEDURE Export (program: BIN.PROGRAM; name: INTEGER; VAR ExportDir: IMAGE_EXPORT_DIRECTORY): INTEGER;
-BEGIN
-
-    ExportDir.Characteristics        :=  0;
-    ExportDir.TimeDateStamp          :=  FileHeader.TimeDateStamp;
-    ExportDir.MajorVersion           :=  0X;
-    ExportDir.MinorVersion           :=  0X;
-    ExportDir.Name                   :=  name;
-    ExportDir.Base                   :=  0;
-    ExportDir.NumberOfFunctions      :=  LISTS.count(program.exp_list);
-    ExportDir.NumberOfNames          :=  ExportDir.NumberOfFunctions;
-    ExportDir.AddressOfFunctions     :=  SIZE_OF_IMAGE_EXPORT_DIRECTORY;
-    ExportDir.AddressOfNames         :=  ExportDir.AddressOfFunctions + ExportDir.NumberOfFunctions * SIZE_OF_DWORD;
-    ExportDir.AddressOfNameOrdinals  :=  ExportDir.AddressOfNames     + ExportDir.NumberOfFunctions * SIZE_OF_DWORD
-
-    RETURN SIZE_OF_IMAGE_EXPORT_DIRECTORY + ExportDir.NumberOfFunctions * (2 * SIZE_OF_DWORD + SIZE_OF_WORD)
-END Export;
-
-
-PROCEDURE GetProcCount (lib: BIN.IMPRT): INTEGER;
-VAR
-    imp: BIN.IMPRT;
-    res: INTEGER;
-
-BEGIN
-    res := 0;
-    imp := lib.next(BIN.IMPRT);
-    WHILE (imp # NIL) & (imp.label # 0) DO
-        INC(res);
-        imp := imp.next(BIN.IMPRT)
-    END
-
-    RETURN res
-END GetProcCount;
-
-
-PROCEDURE GetImportSize (imp_list: LISTS.LIST): INTEGER;
-VAR
-    imp: BIN.IMPRT;
-    proccnt: INTEGER;
-    procoffs: INTEGER;
-    OriginalCurrentThunk,
-    CurrentThunk: INTEGER;
-
-BEGIN
-    libcnt  := 0;
-    proccnt := 0;
-    imp  := imp_list.first(BIN.IMPRT);
-    WHILE imp # NIL DO
-        IF imp.label = 0 THEN
-            INC(libcnt)
-        ELSE
-            INC(proccnt)
-        END;
-        imp := imp.next(BIN.IMPRT)
-    END;
-
-    procoffs := 0;
-
-    imp  := imp_list.first(BIN.IMPRT);
-    WHILE imp # NIL DO
-        IF imp.label = 0 THEN
-            imp.OriginalFirstThunk := procoffs;
-            imp.FirstThunk := procoffs + (GetProcCount(imp) + 1);
-            OriginalCurrentThunk := imp.OriginalFirstThunk;
-            CurrentThunk := imp.FirstThunk;
-            INC(procoffs, (GetProcCount(imp) + 1) * 2)
-        ELSE
-            imp.OriginalFirstThunk := OriginalCurrentThunk;
-            imp.FirstThunk := CurrentThunk;
-            INC(OriginalCurrentThunk);
-            INC(CurrentThunk)
-        END;
-        imp := imp.next(BIN.IMPRT)
-    END
-
-    RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SizeOfWord
-END GetImportSize;
-
-
-PROCEDURE fixup* (program: BIN.PROGRAM; Address: VIRTUAL_ADDR; amd64: BOOLEAN);
-VAR
-    reloc: BIN.RELOC;
-    iproc: BIN.IMPRT;
-    code:  CHL.BYTELIST;
-    L, delta, delta0, AdrImp, offset: INTEGER;
-
-BEGIN
-    AdrImp := Address.Import + (libcnt + 1) * 5 * SIZE_OF_DWORD;
-    code := program.code;
-    reloc := program.rel_list.first(BIN.RELOC);
-    delta0 := 3 - 7 * ORD(amd64) - Address.Code;
-
-    WHILE reloc # NIL DO
-
-        offset := reloc.offset;
-        L := BIN.get32le(code, offset);
-        delta := delta0 - offset;
-
-        CASE reloc.opcode OF
-        |BIN.PICDATA:
-            INC(delta, L + Address.Data)
-
-        |BIN.PICCODE:
-            INC(delta, BIN.GetLabel(program, L) + Address.Code)
-
-        |BIN.PICBSS:
-            INC(delta, L + Address.Bss)
-
-        |BIN.PICIMP:
-            iproc := BIN.GetIProc(program, L);
-            INC(delta, iproc.FirstThunk * SizeOfWord + AdrImp)
-        END;
-        BIN.put32le(code, offset, delta);
-
-        reloc := reloc.next(BIN.RELOC)
-    END
-END fixup;
-
-
-PROCEDURE WriteWord (w: WORD);
-BEGIN
-    WR.Write16LE(ORD(w))
-END WriteWord;
-
-
-PROCEDURE WriteName* (name: NAME);
-VAR
-    i, nameLen: INTEGER;
-
-BEGIN
-    nameLen := LENGTH(name);
-
-    FOR i := 0 TO nameLen - 1 DO
-        WR.WriteByte(ORD(name[i]))
-    END;
-
-    i := LEN(name) - nameLen;
-    WHILE i > 0 DO
-        WR.WriteByte(0);
-        DEC(i)
-    END
-
-END WriteName;
-
-
-PROCEDURE WriteSectionHeader* (h: IMAGE_SECTION_HEADER);
-VAR
-    i, nameLen: INTEGER;
-
-BEGIN
-    nameLen := LENGTH(h.Name);
-
-    FOR i := 0 TO nameLen - 1 DO
-        WR.WriteByte(ORD(h.Name[i]))
-    END;
-
-    i := LEN(h.Name) - nameLen;
-    WHILE i > 0 DO
-        WR.WriteByte(0);
-        DEC(i)
-    END;
-
-    WR.Write32LE(h.VirtualSize);
-    WR.Write32LE(h.VirtualAddress);
-    WR.Write32LE(h.SizeOfRawData);
-    WR.Write32LE(h.PointerToRawData);
-    WR.Write32LE(h.PointerToRelocations);
-    WR.Write32LE(h.PointerToLinenumbers);
-
-    WriteWord(h.NumberOfRelocations);
-    WriteWord(h.NumberOfLinenumbers);
-
-    WR.Write32LE(h.Characteristics)
-END WriteSectionHeader;
-
-
-PROCEDURE WriteFileHeader* (h: IMAGE_FILE_HEADER);
-BEGIN
-    WriteWord(h.Machine);
-    WriteWord(h.NumberOfSections);
-
-    WR.Write32LE(h.TimeDateStamp);
-    WR.Write32LE(h.PointerToSymbolTable);
-    WR.Write32LE(h.NumberOfSymbols);
-
-    WriteWord(h.SizeOfOptionalHeader);
-    WriteWord(h.Characteristics)
-END WriteFileHeader;
-
-
-PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; console, dll, amd64: BOOLEAN);
-VAR
-    i, n, temp: INTEGER;
-
-    Size: RECORD
-
-        Code, Data, Bss, Import, Reloc, Export: INTEGER
-
-    END;
-
-    BaseAddress: INTEGER;
-
-    Address: VIRTUAL_ADDR;
-
-    _import:      BIN.IMPRT;
-    ImportTable:  CHL.INTLIST;
-
-    ExportDir:  IMAGE_EXPORT_DIRECTORY;
-    export:     BIN.EXPRT;
-
-
-    PROCEDURE WriteExportDir (e: IMAGE_EXPORT_DIRECTORY);
-    BEGIN
-        WR.Write32LE(e.Characteristics);
-        WR.Write32LE(e.TimeDateStamp);
-
-        WriteWord(e.MajorVersion);
-        WriteWord(e.MinorVersion);
-
-        WR.Write32LE(e.Name);
-        WR.Write32LE(e.Base);
-        WR.Write32LE(e.NumberOfFunctions);
-        WR.Write32LE(e.NumberOfNames);
-        WR.Write32LE(e.AddressOfFunctions);
-        WR.Write32LE(e.AddressOfNames);
-        WR.Write32LE(e.AddressOfNameOrdinals)
-    END WriteExportDir;
-
-
-    PROCEDURE WriteOptHeader (h: IMAGE_OPTIONAL_HEADER; amd64: BOOLEAN);
-    VAR
-        i: INTEGER;
-
-    BEGIN
-        WriteWord(h.Magic);
-
-        WR.WriteByte(h.MajorLinkerVersion);
-        WR.WriteByte(h.MinorLinkerVersion);
-
-        WR.Write32LE(h.SizeOfCode);
-        WR.Write32LE(h.SizeOfInitializedData);
-        WR.Write32LE(h.SizeOfUninitializedData);
-        WR.Write32LE(h.AddressOfEntryPoint);
-        WR.Write32LE(h.BaseOfCode);
-
-        IF amd64 THEN
-            WR.Write64LE(h.ImageBase)
-        ELSE
-            WR.Write32LE(h.BaseOfData);
-            WR.Write32LE(h.ImageBase)
-        END;
-
-        WR.Write32LE(h.SectionAlignment);
-        WR.Write32LE(h.FileAlignment);
-
-        WriteWord(h.MajorOperatingSystemVersion);
-        WriteWord(h.MinorOperatingSystemVersion);
-        WriteWord(h.MajorImageVersion);
-        WriteWord(h.MinorImageVersion);
-        WriteWord(h.MajorSubsystemVersion);
-        WriteWord(h.MinorSubsystemVersion);
-
-        WR.Write32LE(h.Win32VersionValue);
-        WR.Write32LE(h.SizeOfImage);
-        WR.Write32LE(h.SizeOfHeaders);
-        WR.Write32LE(h.CheckSum);
-
-        WriteWord(h.Subsystem);
-        WriteWord(h.DllCharacteristics);
-
-        IF amd64 THEN
-            WR.Write64LE(h.SizeOfStackReserve);
-            WR.Write64LE(h.SizeOfStackCommit);
-            WR.Write64LE(h.SizeOfHeapReserve);
-            WR.Write64LE(h.SizeOfHeapCommit)
-        ELSE
-            WR.Write32LE(h.SizeOfStackReserve);
-            WR.Write32LE(h.SizeOfStackCommit);
-            WR.Write32LE(h.SizeOfHeapReserve);
-            WR.Write32LE(h.SizeOfHeapCommit)
-        END;
-
-        WR.Write32LE(h.LoaderFlags);
-        WR.Write32LE(h.NumberOfRvaAndSizes);
-
-        FOR i := 0 TO LEN(h.DataDirectory) - 1 DO
-            WR.Write32LE(h.DataDirectory[i].VirtualAddress);
-            WR.Write32LE(h.DataDirectory[i].Size)
-        END
-
-    END WriteOptHeader;
-
-
-    PROCEDURE InitSection (VAR section: IMAGE_SECTION_HEADER; Name: NAME; VirtualSize: INTEGER; Characteristics: DWORD);
-    BEGIN
-        section.Name                  :=  Name;
-        section.VirtualSize           :=  VirtualSize;
-        section.SizeOfRawData         :=  WR.align(VirtualSize, FileAlignment);
-        section.PointerToRelocations  :=  0;
-        section.PointerToLinenumbers  :=  0;
-        section.NumberOfRelocations   :=  0X;
-        section.NumberOfLinenumbers   :=  0X;
-        section.Characteristics       :=  Characteristics
-    END InitSection;
-
-
-BEGIN
-    SizeOfWord := SIZE_OF_DWORD * (ORD(amd64) + 1);
-
-    Size.Code  := CHL.Length(program.code);
-    Size.Data  := CHL.Length(program.data);
-    Size.Bss   := program.bss;
-
-    IF dll THEN
-        BaseAddress := 10000000H
-    ELSE
-        BaseAddress := 400000H
-    END;
-
-    Signature[0] := 50H;
-    Signature[1] := 45H;
-    Signature[2] := 0;
-    Signature[3] := 0;
-
-    IF amd64 THEN
-        FileHeader.Machine := 08664X
-    ELSE
-        FileHeader.Machine := 014CX
-    END;
-
-    FileHeader.NumberOfSections := WCHR(4 + ORD(dll));
-
-    FileHeader.TimeDateStamp         :=  UTILS.UnixTime();
-    FileHeader.PointerToSymbolTable  :=  0H;
-    FileHeader.NumberOfSymbols       :=  0H;
-    FileHeader.SizeOfOptionalHeader  :=  WCHR(0E0H + 10H * ORD(amd64));
-    FileHeader.Characteristics       :=  WCHR(010EH + (20H - 100H) * ORD(amd64) + 2000H * ORD(dll));
-
-    OptionalHeader.Magic                        :=  WCHR(010BH + 100H * ORD(amd64));
-    OptionalHeader.MajorLinkerVersion           :=  UTILS.vMajor;
-    OptionalHeader.MinorLinkerVersion           :=  UTILS.vMinor;
-    OptionalHeader.SizeOfCode                   :=  WR.align(Size.Code, FileAlignment);
-    OptionalHeader.SizeOfInitializedData        :=  0;
-    OptionalHeader.SizeOfUninitializedData      :=  0;
-    OptionalHeader.AddressOfEntryPoint          :=  SectionAlignment;
-    OptionalHeader.BaseOfCode                   :=  SectionAlignment;
-    OptionalHeader.BaseOfData                   :=  OptionalHeader.BaseOfCode + WR.align(Size.Code, SectionAlignment);
-    OptionalHeader.ImageBase                    :=  BaseAddress;
-    OptionalHeader.SectionAlignment             :=  SectionAlignment;
-    OptionalHeader.FileAlignment                :=  FileAlignment;
-    OptionalHeader.MajorOperatingSystemVersion  :=  1X;
-    OptionalHeader.MinorOperatingSystemVersion  :=  0X;
-    OptionalHeader.MajorImageVersion            :=  0X;
-    OptionalHeader.MinorImageVersion            :=  0X;
-    OptionalHeader.MajorSubsystemVersion        :=  4X;
-    OptionalHeader.MinorSubsystemVersion        :=  0X;
-    OptionalHeader.Win32VersionValue            :=  0H;
-    OptionalHeader.SizeOfImage                  :=  SectionAlignment;
-    OptionalHeader.SizeOfHeaders                :=  400H;
-    OptionalHeader.CheckSum                     :=  0;
-    OptionalHeader.Subsystem                    :=  WCHR((2 + ORD(console)) * ORD(~dll));
-    OptionalHeader.DllCharacteristics           :=  0040X;
-    OptionalHeader.SizeOfStackReserve           :=  100000H;
-    OptionalHeader.SizeOfStackCommit            :=  10000H;
-    OptionalHeader.SizeOfHeapReserve            :=  100000H;
-    OptionalHeader.SizeOfHeapCommit             :=  10000H;
-    OptionalHeader.LoaderFlags                  :=  0;
-    OptionalHeader.NumberOfRvaAndSizes          :=  IMAGE_NUMBEROF_DIRECTORY_ENTRIES;
-
-    FOR i := 0 TO IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1 DO
-        OptionalHeader.DataDirectory[i].VirtualAddress := 0;
-        OptionalHeader.DataDirectory[i].Size := 0
-    END;
-
-    InitSection(SectionHeaders[0], ".text", Size.Code, SHC_text);
-    SectionHeaders[0].VirtualAddress   := SectionAlignment;
-    SectionHeaders[0].PointerToRawData := OptionalHeader.SizeOfHeaders;
-
-    InitSection(SectionHeaders[1], ".data", Size.Data, SHC_data);
-    SectionHeaders[1].VirtualAddress   := WR.align(SectionHeaders[0].VirtualAddress + SectionHeaders[0].VirtualSize, SectionAlignment);
-    SectionHeaders[1].PointerToRawData := SectionHeaders[0].PointerToRawData + SectionHeaders[0].SizeOfRawData;
-
-    InitSection(SectionHeaders[2], ".bss", Size.Bss, SHC_bss);
-    SectionHeaders[2].VirtualAddress   := WR.align(SectionHeaders[1].VirtualAddress + SectionHeaders[1].VirtualSize, SectionAlignment);
-    SectionHeaders[2].PointerToRawData := SectionHeaders[1].PointerToRawData + SectionHeaders[1].SizeOfRawData;
-    SectionHeaders[2].SizeOfRawData    := 0;
-
-    Size.Import := GetImportSize(program.imp_list);
-
-    InitSection(SectionHeaders[3], ".idata", Size.Import + CHL.Length(program._import), SHC_data);
-    SectionHeaders[3].VirtualAddress   := WR.align(SectionHeaders[2].VirtualAddress + SectionHeaders[2].VirtualSize, SectionAlignment);
-    SectionHeaders[3].PointerToRawData := SectionHeaders[2].PointerToRawData + SectionHeaders[2].SizeOfRawData;
-
-    Address.Code   := SectionHeaders[0].VirtualAddress + OptionalHeader.ImageBase;
-    Address.Data   := SectionHeaders[1].VirtualAddress + OptionalHeader.ImageBase;
-    Address.Bss    := SectionHeaders[2].VirtualAddress + OptionalHeader.ImageBase;
-    Address.Import := SectionHeaders[3].VirtualAddress + OptionalHeader.ImageBase;
-
-    fixup(program, Address, amd64);
-
-    IF dll THEN
-        Size.Export := Export(program, SectionHeaders[1].VirtualAddress + program.modname, ExportDir);
-
-        InitSection(SectionHeaders[4], ".edata", Size.Export + CHL.Length(program.export), SHC_data);
-        SectionHeaders[4].VirtualAddress   := WR.align(SectionHeaders[3].VirtualAddress + SectionHeaders[3].VirtualSize, SectionAlignment);
-        SectionHeaders[4].PointerToRawData := SectionHeaders[3].PointerToRawData + SectionHeaders[3].SizeOfRawData;
-
-        OptionalHeader.DataDirectory[0].VirtualAddress := SectionHeaders[4].VirtualAddress;
-        OptionalHeader.DataDirectory[0].Size := SectionHeaders[4].VirtualSize
-    END;
-
-    OptionalHeader.DataDirectory[1].VirtualAddress := SectionHeaders[3].VirtualAddress;
-    OptionalHeader.DataDirectory[1].Size := SectionHeaders[3].VirtualSize;
-
-    FOR i := 1 TO ORD(FileHeader.NumberOfSections) - 1 DO
-        INC(OptionalHeader.SizeOfInitializedData, SectionHeaders[i].SizeOfRawData)
-    END;
-
-    OptionalHeader.SizeOfUninitializedData := WR.align(SectionHeaders[2].VirtualSize, FileAlignment);
-
-    FOR i := 0 TO ORD(FileHeader.NumberOfSections) - 1 DO
-        INC(OptionalHeader.SizeOfImage, WR.align(SectionHeaders[i].VirtualSize, SectionAlignment))
-    END;
-
-    n := 0;
-    BIN.InitArray(msdos, n, "4D5A80000100000004001000FFFF000040010000000000004000000000000000");
-    BIN.InitArray(msdos, n, "0000000000000000000000000000000000000000000000000000000080000000");
-    BIN.InitArray(msdos, n, "0E1FBA0E00B409CD21B8014CCD21546869732070726F6772616D2063616E6E6F");
-    BIN.InitArray(msdos, n, "742062652072756E20696E20444F53206D6F64652E0D0A240000000000000000");
-
-    WR.Create(FileName);
-
-    WR.Write(msdos, LEN(msdos));
-
-    WR.Write(Signature, LEN(Signature));
-    WriteFileHeader(FileHeader);
-    WriteOptHeader(OptionalHeader, amd64);
-
-    FOR i := 0 TO ORD(FileHeader.NumberOfSections) - 1 DO
-        WriteSectionHeader(SectionHeaders[i])
-    END;
-
-    WR.Padding(FileAlignment);
-
-    CHL.WriteToFile(program.code);
-    WR.Padding(FileAlignment);
-
-    CHL.WriteToFile(program.data);
-    WR.Padding(FileAlignment);
-
-    n := (libcnt + 1) * 5;
-    ImportTable := CHL.CreateIntList();
-
-    FOR i := 0 TO (Size.Import - n * SIZE_OF_DWORD) DIV SizeOfWord + n - 1 DO
-        CHL.PushInt(ImportTable, 0)
-    END;
-
-    i := 0;
-    _import := program.imp_list.first(BIN.IMPRT);
-    WHILE _import # NIL DO
-        IF _import.label = 0 THEN
-            CHL.SetInt(ImportTable, i + 0, _import.OriginalFirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
-            CHL.SetInt(ImportTable, i + 1, 0);
-            CHL.SetInt(ImportTable, i + 2, 0);
-            CHL.SetInt(ImportTable, i + 3, _import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress);
-            CHL.SetInt(ImportTable, i + 4, _import.FirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
-            INC(i, 5)
-        END;
-        _import := _import.next(BIN.IMPRT)
-    END;
-
-    CHL.SetInt(ImportTable, i + 0, 0);
-    CHL.SetInt(ImportTable, i + 1, 0);
-    CHL.SetInt(ImportTable, i + 2, 0);
-    CHL.SetInt(ImportTable, i + 3, 0);
-    CHL.SetInt(ImportTable, i + 4, 0);
-
-    _import := program.imp_list.first(BIN.IMPRT);
-    WHILE _import # NIL DO
-        IF _import.label # 0 THEN
-            temp := _import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2;
-            CHL.SetInt(ImportTable, _import.OriginalFirstThunk + n, temp);
-            CHL.SetInt(ImportTable, _import.FirstThunk + n,         temp)
-        END;
-        _import := _import.next(BIN.IMPRT)
-    END;
-
-    FOR i := 0 TO n - 1 DO
-        WR.Write32LE(CHL.GetInt(ImportTable, i))
-    END;
-
-    FOR i := n TO CHL.Length(ImportTable) - 1 DO
-        IF amd64 THEN
-            WR.Write64LE(CHL.GetInt(ImportTable, i))
-        ELSE
-            WR.Write32LE(CHL.GetInt(ImportTable, i))
-        END
-    END;
-
-    CHL.WriteToFile(program._import);
-    WR.Padding(FileAlignment);
-
-    IF dll THEN
-
-        INC(ExportDir.AddressOfFunctions,    SectionHeaders[4].VirtualAddress);
-        INC(ExportDir.AddressOfNames,        SectionHeaders[4].VirtualAddress);
-        INC(ExportDir.AddressOfNameOrdinals, SectionHeaders[4].VirtualAddress);
-
-        WriteExportDir(ExportDir);
-
-        export := program.exp_list.first(BIN.EXPRT);
-        WHILE export # NIL DO
-            WR.Write32LE(export.label + SectionHeaders[0].VirtualAddress);
-            export := export.next(BIN.EXPRT)
-        END;
-
-        export := program.exp_list.first(BIN.EXPRT);
-        WHILE export # NIL DO
-            WR.Write32LE(export.nameoffs + Size.Export + SectionHeaders[4].VirtualAddress);
-            export := export.next(BIN.EXPRT)
-        END;
-
-        FOR i := 0 TO ExportDir.NumberOfFunctions - 1 DO
-            WriteWord(WCHR(i))
-        END;
-
-        CHL.WriteToFile(program.export);
-        WR.Padding(FileAlignment)
-    END;
-
-    WR.Close
-END write;
-
-
-END PE32.

programs/develop/oberon07/source/REG.ob07

@@ -1,286 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE REG;
-
-
-CONST
-
-    N = 16;
-
-    R0*  =  0;  R1*  =  1;  R2*  =  2;  R3*  =  3;
-    R4*  =  4;  R5*  =  5;  R6*  =  6;  R7*  =  7;
-    R8*  =  8;  R9*  =  9;  R10* = 10;  R11* = 11;
-    R12* = 12;  R13* = 13;  R14* = 14;  R15* = 15;
-
-
-TYPE
-
-    OP1 = PROCEDURE (arg: INTEGER);
-    OP2 = PROCEDURE (arg1, arg2: INTEGER);
-
-    REGS* = RECORD
-
-        regs*:   SET;
-        stk*:    ARRAY N OF INTEGER;
-        top*:    INTEGER;
-        pushed*: INTEGER;
-
-        push, pop:  OP1;
-        mov,  xch:  OP2
-
-    END;
-
-
-PROCEDURE push (VAR R: REGS);
-VAR
-    i, reg: INTEGER;
-
-BEGIN
-    reg := R.stk[0];
-    INCL(R.regs, reg);
-    R.push(reg);
-    FOR i := 0 TO R.top - 1 DO
-        R.stk[i] := R.stk[i + 1]
-    END;
-    DEC(R.top);
-    INC(R.pushed)
-END push;
-
-
-PROCEDURE pop (VAR R: REGS; reg: INTEGER);
-VAR
-    i: INTEGER;
-
-BEGIN
-    FOR i := R.top + 1 TO 1 BY -1 DO
-        R.stk[i] := R.stk[i - 1]
-    END;
-    R.stk[0] := reg;
-    EXCL(R.regs, reg);
-    R.pop(reg);
-    INC(R.top);
-    DEC(R.pushed)
-END pop;
-
-
-PROCEDURE InStk (R: REGS; reg: INTEGER): INTEGER;
-VAR
-    i: INTEGER;
-
-BEGIN
-    i := R.top;
-    WHILE (i >= 0) & (R.stk[i] # reg) DO
-        DEC(i)
-    END
-
-    RETURN i
-END InStk;
-
-
-PROCEDURE GetFreeReg (R: REGS): INTEGER;
-VAR
-    i: INTEGER;
-
-BEGIN
-    i := 0;
-    WHILE (i < N) & ~(i IN R.regs) DO
-        INC(i)
-    END;
-
-    IF i = N THEN
-        i := -1
-    END
-
-    RETURN i
-END GetFreeReg;
-
-
-PROCEDURE Put (VAR R: REGS; reg: INTEGER);
-BEGIN
-    EXCL(R.regs, reg);
-    INC(R.top);
-    R.stk[R.top] := reg
-END Put;
-
-
-PROCEDURE PopAnyReg (VAR R: REGS): INTEGER;
-VAR
-    reg: INTEGER;
-
-BEGIN
-    reg := GetFreeReg(R);
-    ASSERT(reg # -1);
-    ASSERT(R.top < LEN(R.stk) - 1);
-    ASSERT(R.pushed > 0);
-    pop(R, reg)
-
-    RETURN reg
-END PopAnyReg;
-
-
-PROCEDURE GetAnyReg* (VAR R: REGS): INTEGER;
-VAR
-    reg: INTEGER;
-
-BEGIN
-    reg := GetFreeReg(R);
-    IF reg = -1 THEN
-        ASSERT(R.top >= 0);
-        reg := R.stk[0];
-        push(R)
-    END;
-
-    Put(R, reg)
-
-    RETURN reg
-END GetAnyReg;
-
-
-PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN;
-VAR
-    free: INTEGER;
-    res:  BOOLEAN;
-
-
-    PROCEDURE exch (VAR R: REGS; reg1, reg2: INTEGER);
-    VAR
-        n1, n2: INTEGER;
-
-    BEGIN
-        n1 := InStk(R, reg1);
-        n2 := InStk(R, reg2);
-        R.stk[n1] := reg2;
-        R.stk[n2] := reg1;
-        R.xch(reg1, reg2)
-    END exch;
-
-
-BEGIN
-    IF reg IN R.regs THEN
-        Put(R, reg);
-        res := TRUE
-    ELSE
-        res := InStk(R, reg) # -1;
-        IF res THEN
-            free := GetFreeReg(R);
-            IF free # -1 THEN
-                Put(R, free);
-                exch(R, reg, free)
-            ELSE
-                push(R);
-                free := GetFreeReg(R);
-                ASSERT(free # -1);
-                Put(R, free);
-                IF free # reg THEN
-                    exch(R, reg, free)
-                END
-            END
-        END
-    END
-
-    RETURN res
-END GetReg;
-
-
-PROCEDURE Exchange* (VAR R: REGS; reg1, reg2: INTEGER): BOOLEAN;
-VAR
-    n1, n2: INTEGER;
-    res: BOOLEAN;
-
-BEGIN
-    res := TRUE;
-
-    IF reg1 # reg2 THEN
-        n1 := InStk(R, reg1);
-        n2 := InStk(R, reg2);
-
-        IF (n1 # -1) & (n2 # -1) THEN
-            R.stk[n1] := reg2;
-            R.stk[n2] := reg1;
-            R.xch(reg2, reg1)
-        ELSIF (n1 # -1) & (reg2 IN R.regs) THEN
-            R.stk[n1] := reg2;
-            INCL(R.regs, reg1);
-            EXCL(R.regs, reg2);
-            R.mov(reg2, reg1)
-        ELSIF (n2 # -1) & (reg1 IN R.regs) THEN
-            R.stk[n2] := reg1;
-            EXCL(R.regs, reg1);
-            INCL(R.regs, reg2);
-            R.mov(reg1, reg2)
-        ELSE
-            res := FALSE
-        END
-    END
-
-    RETURN res
-END Exchange;
-
-
-PROCEDURE Drop* (VAR R: REGS);
-BEGIN
-    INCL(R.regs, R.stk[R.top]);
-    DEC(R.top)
-END Drop;
-
-
-PROCEDURE BinOp* (VAR R: REGS; VAR reg1, reg2: INTEGER);
-BEGIN
-    IF R.top > 0 THEN
-        reg1 := R.stk[R.top - 1];
-        reg2 := R.stk[R.top]
-    ELSIF R.top = 0 THEN
-        reg1 := PopAnyReg(R);
-        reg2 := R.stk[1]
-    ELSE (* R.top = -1 *)
-        reg2 := PopAnyReg(R);
-        reg1 := PopAnyReg(R)
-    END
-END BinOp;
-
-
-PROCEDURE UnOp* (VAR R: REGS; VAR reg: INTEGER);
-BEGIN
-    IF R.top >= 0 THEN
-        reg := R.stk[R.top]
-    ELSE
-        reg := PopAnyReg(R)
-    END
-END UnOp;
-
-
-PROCEDURE PushAll* (VAR R: REGS);
-BEGIN
-    WHILE R.top >= 0 DO
-        push(R)
-    END
-END PushAll;
-
-
-PROCEDURE PushAll_1* (VAR R: REGS);
-BEGIN
-    WHILE R.top >= 1 DO
-        push(R)
-    END
-END PushAll_1;
-
-
-PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; regs: SET);
-BEGIN
-    R.regs := regs;
-    R.pushed := 0;
-    R.top := -1;
-
-    R.push := push;
-    R.pop  := pop;
-    R.mov  := mov;
-    R.xch  := xch;
-END Init;
-
-
-END REG.

programs/develop/oberon07/source/SCAN.ob07

@@ -1,783 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE SCAN;
-
-IMPORT TXT := TEXTDRV, ARITH, S := STRINGS, ERRORS, LISTS;
-
-
-CONST
-
-    NUMLEN  = 256;
-    IDLEN   = 256;
-    TEXTLEN = 512;
-
-    lxUNDEF*   =  0;  lxIDENT*   =  1;  lxINTEGER*   =  2;  lxHEX*     =  3;
-    lxCHAR*    =  4;  lxFLOAT*   =  5;  lxSTRING*    =  6;  lxCOMMENT* =  7;
-    lxEOF*     =  8;
-
-    lxPLUS*    = 21;  lxMINUS*   = 22;  lxMUL*       = 23;  lxSLASH*   = 24;
-    lxNOT*     = 25;  lxAND*     = 26;  lxPOINT*     = 27;  lxCOMMA*   = 28;
-    lxSEMI*    = 29;  lxBAR*     = 30;  lxLROUND*    = 31;  lxLSQUARE* = 32;
-    lxLCURLY*  = 33;  lxCARET*   = 34;  lxEQ*        = 35;  lxNE*      = 36;
-    lxLT*      = 37;  lxGT*      = 38;  lxCOLON*     = 39;  lxRROUND*  = 40;
-    lxRSQUARE* = 41;  lxRCURLY*  = 42;  lxLE*        = 43;  lxGE*      = 44;
-    lxASSIGN*  = 45;  lxRANGE*   = 46;
-
-    lxKW       = 51;
-
-    lxARRAY*   = 51;  lxBEGIN*   = 52;  lxBY*        = 53;  lxCASE*    = 54;
-    lxCONST*   = 55;  lxDIV*     = 56;  lxDO*        = 57;  lxELSE*    = 58;
-    lxELSIF*   = 59;  lxEND*     = 60;  lxFALSE*     = 61;  lxFOR*     = 62;
-    lxIF*      = 63;  lxIMPORT*  = 64;  lxIN*        = 65;  lxIS*      = 66;
-    lxMOD*     = 67;  lxMODULE*  = 68;  lxNIL*       = 69;  lxOF*      = 70;
-    lxOR*      = 71;  lxPOINTER* = 72;  lxPROCEDURE* = 73;  lxRECORD*  = 74;
-    lxREPEAT*  = 75;  lxRETURN*  = 76;  lxTHEN*      = 77;  lxTO*      = 78;
-    lxTRUE*    = 79;  lxTYPE*    = 80;  lxUNTIL*     = 81;  lxVAR*     = 82;
-    lxWHILE*   = 83;
-
-    lxERROR01* =  -1;  lxERROR02* =  -2;  lxERROR03* =  -3;  lxERROR04* =  -4;
-    lxERROR05* =  -5;  (*lxERROR06* =  -6;*)  lxERROR07* =  -7;  lxERROR08* =  -8;
-    lxERROR09* =  -9;  lxERROR10* = -10;  lxERROR11* = -11;  lxERROR12* = -12;
-    lxERROR13* = -13;
-
-
-TYPE
-
-    TEXTSTR* = ARRAY TEXTLEN OF CHAR;
-    IDSTR* = ARRAY IDLEN OF CHAR;
-
-    DEF = POINTER TO RECORD (LISTS.ITEM)
-
-        ident: IDSTR
-
-    END;
-
-    STRING* = POINTER TO RECORD (LISTS.ITEM)
-
-        s*: TEXTSTR;
-        offset*, offsetW*, hash: INTEGER
-
-    END;
-
-    IDENT* = RECORD
-
-        s*:    IDSTR;
-        hash*: INTEGER
-
-    END;
-
-    POSITION* = RECORD
-
-        line*, col*: INTEGER
-
-    END;
-
-    LEX* = RECORD
-
-        sym*:       INTEGER;
-        pos*:       POSITION;
-        ident*:     IDENT;
-        string*:    STRING;
-        value*:     ARITH.VALUE;
-        error*:     INTEGER
-
-    END;
-
-    SCANNER* = TXT.TEXT;
-
-    KEYWORD = ARRAY 10 OF CHAR;
-
-
-VAR
-
-    delimiters: ARRAY 256 OF BOOLEAN;
-
-    upto, LowerCase, _if: BOOLEAN;
-
-    strings, def: LISTS.LIST;
-
-    KW: ARRAY 33 OF RECORD upper, lower: KEYWORD; uhash, lhash: INTEGER END;
-
-
-PROCEDURE enterKW (s: KEYWORD; idx: INTEGER);
-BEGIN
-    KW[idx].lower := s;
-    KW[idx].upper := s;
-    S.UpCase(KW[idx].upper);
-    KW[idx].uhash := S.HashStr(KW[idx].upper);
-    KW[idx].lhash := S.HashStr(KW[idx].lower);
-END enterKW;
-
-
-PROCEDURE checkKW (ident: IDENT): INTEGER;
-VAR
-    i, res: INTEGER;
-
-BEGIN
-    res := lxIDENT;
-    i := 0;
-    WHILE i < LEN(KW) DO
-        IF (KW[i].uhash = ident.hash) & (KW[i].upper = ident.s)
-        OR LowerCase & (KW[i].lhash = ident.hash) & (KW[i].lower = ident.s) THEN
-            res := i + lxKW;
-            i := LEN(KW)
-        END;
-        INC(i)
-    END
-
-    RETURN res
-END checkKW;
-
-
-PROCEDURE enterStr* (s: TEXTSTR): STRING;
-VAR
-    str, res: STRING;
-    hash: INTEGER;
-
-BEGIN
-    hash := S.HashStr(s);
-    str := strings.first(STRING);
-    res := NIL;
-    WHILE str # NIL DO
-        IF (str.hash = hash) & (str.s = s) THEN
-            res := str;
-            str := NIL
-        ELSE
-            str := str.next(STRING)
-        END
-    END;
-    IF res = NIL THEN
-        NEW(res);
-        res.s := s;
-        res.offset  := -1;
-        res.offsetW := -1;
-        res.hash := hash;
-        LISTS.push(strings, res)
-    END
-
-    RETURN res
-END enterStr;
-
-
-PROCEDURE nextc (text: TXT.TEXT): CHAR;
-BEGIN
-    TXT.next(text)
-    RETURN text.peak
-END nextc;
-
-
-PROCEDURE setIdent* (VAR ident: IDENT; s: IDSTR);
-BEGIN
-    ident.s := s;
-    ident.hash := S.HashStr(s)
-END setIdent;
-
-
-PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
-VAR
-    c: CHAR;
-    i: INTEGER;
-
-BEGIN
-    c := text.peak;
-    ASSERT(S.letter(c));
-
-    i := 0;
-    WHILE (i < IDLEN - 1) & (S.letter(c) OR S.digit(c)) DO
-        lex.ident.s[i] := c;
-        INC(i);
-        c := nextc(text)
-    END;
-
-    lex.ident.s[i] := 0X;
-    lex.ident.hash := S.HashStr(lex.ident.s);
-    lex.sym := checkKW(lex.ident);
-
-    IF S.letter(c) OR S.digit(c) THEN
-        ERRORS.WarningMsg(lex.pos.line, lex.pos.col, 2);
-        WHILE S.letter(c) OR S.digit(c) DO
-            c := nextc(text)
-        END
-    END
-END ident;
-
-
-PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
-TYPE
-    NUMSTR = ARRAY NUMLEN OF CHAR;
-
-VAR
-    c: CHAR;
-    hex: BOOLEAN;
-    error, sym, i: INTEGER;
-    num: NUMSTR;
-
-
-    PROCEDURE push (VAR num: NUMSTR; VAR i: INTEGER; c: CHAR);
-    BEGIN
-        IF i < NUMLEN - 1 THEN
-            num[i] := c;
-            INC(i)
-        END
-    END push;
-
-
-BEGIN
-    c := text.peak;
-    ASSERT(S.digit(c));
-
-    i := 0;
-
-    error := 0;
-
-    sym := lxINTEGER;
-    hex := FALSE;
-
-    WHILE S.digit(c) DO
-        push(num, i, c);
-        c := nextc(text)
-    END;
-
-    WHILE S.hexdigit(c) OR LowerCase & ("a" <= c) & (c <= "f") DO
-        S.cap(c);
-        push(num, i, c);
-        c := nextc(text);
-        hex := TRUE
-    END;
-
-    IF (c = "H") OR LowerCase & (c = "h") THEN
-        push(num, i, c);
-        TXT.next(text);
-        sym := lxHEX
-
-    ELSIF (c = "X") OR LowerCase & (c = "x") THEN
-        push(num, i, c);
-        TXT.next(text);
-        sym := lxCHAR
-
-    ELSIF c = "." THEN
-
-        IF hex THEN
-            sym := lxERROR01
-        ELSE
-
-            c := nextc(text);
-
-            IF c # "." THEN
-                push(num, i, ".");
-                sym := lxFLOAT
-            ELSE
-                sym := lxINTEGER;
-                text.peak := 7FX;
-                upto := TRUE
-            END;
-
-            WHILE S.digit(c) DO
-                push(num, i, c);
-                c := nextc(text)
-            END;
-
-            IF (c = "E") OR LowerCase & (c = "e") THEN
-
-                push(num, i, c);
-                c := nextc(text);
-                IF (c = "+") OR (c = "-") THEN
-                    push(num, i, c);
-                    c := nextc(text)
-                END;
-
-                IF S.digit(c) THEN
-                    WHILE S.digit(c) DO
-                        push(num, i, c);
-                        c := nextc(text)
-                    END
-                ELSE
-                    sym := lxERROR02
-                END
-
-            END
-
-        END
-
-    ELSIF hex THEN
-        sym := lxERROR01
-
-    END;
-
-    IF (i = NUMLEN - 1) & (sym >= 0) THEN
-        sym := lxERROR07
-    END;
-
-    num[i] := 0X;
-
-    IF sym = lxINTEGER THEN
-        ARITH.iconv(num, lex.value, error)
-    ELSIF (sym = lxHEX) OR (sym = lxCHAR) THEN
-        ARITH.hconv(num, lex.value, error)
-    ELSIF sym = lxFLOAT THEN
-        ARITH.fconv(num, lex.value, error)
-    END;
-
-    CASE error OF
-    |0:
-    |1: sym := lxERROR08
-    |2: sym := lxERROR09
-    |3: sym := lxERROR10
-    |4: sym := lxERROR11
-    |5: sym := lxERROR12
-    END;
-
-    lex.sym := sym
-END number;
-
-
-PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
-VAR
-    c: CHAR;
-    i: INTEGER;
-    str: TEXTSTR;
-
-BEGIN
-    c  := nextc(text);
-
-    i := 0;
-    WHILE (i < LEN(str) - 1) & (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
-        str[i] := c;
-        c := nextc(text);
-        INC(i)
-    END;
-
-    str[i] := 0X;
-
-    IF (i = LEN(str) - 1) & (c # quot) & (c # 0X) & ~text.eol & ~text.eof THEN
-        lex.sym := lxERROR05
-    END;
-
-    IF c = quot THEN
-        TXT.next(text);
-        IF i # 1 THEN
-            lex.sym := lxSTRING
-        ELSE
-            lex.sym := lxCHAR;
-            ARITH.setChar(lex.value, ORD(str[0]))
-        END
-    ELSIF lex.sym # lxERROR05 THEN
-        lex.sym := lxERROR03
-    END;
-
-    IF lex.sym = lxSTRING THEN
-        lex.string := enterStr(str);
-        lex.value.typ := ARITH.tSTRING;
-        lex.value.string := lex.string
-    END
-
-END string;
-
-
-PROCEDURE comment (text: TXT.TEXT);
-VAR
-    c: CHAR;
-    cond, depth: INTEGER;
-
-BEGIN
-    cond  := 0;
-    depth := 1;
-
-    REPEAT
-
-        c := text.peak;
-        TXT.next(text);
-
-        IF c = "*" THEN
-            IF cond = 1 THEN
-                cond := 0;
-                INC(depth)
-            ELSE
-               cond := 2
-            END
-        ELSIF c = ")" THEN
-            IF cond = 2 THEN
-                DEC(depth)
-            END;
-            cond := 0
-        ELSIF c = "(" THEN
-            cond := 1
-        ELSE
-            cond := 0
-        END
-
-    UNTIL (depth = 0) OR text.eof
-
-END comment;
-
-
-PROCEDURE delimiter (text: TXT.TEXT; c: CHAR): INTEGER;
-VAR
-    sym: INTEGER;
-    c0:  CHAR;
-
-BEGIN
-    c0 := c;
-    c := nextc(text);
-
-    CASE c0 OF
-    |"+":
-        sym := lxPLUS
-
-    |"-":
-        sym := lxMINUS
-
-    |"*":
-        sym := lxMUL
-
-    |"/":
-        sym := lxSLASH;
-
-        IF c = "/" THEN
-            sym := lxCOMMENT;
-            REPEAT
-                TXT.next(text)
-            UNTIL text.eol OR text.eof
-        END
-
-    |"~":
-        sym := lxNOT
-
-    |"&":
-        sym := lxAND
-
-    |".":
-        sym := lxPOINT;
-
-        IF c = "." THEN
-            sym := lxRANGE;
-            TXT.next(text)
-        END
-
-    |",":
-        sym := lxCOMMA
-
-    |";":
-        sym := lxSEMI
-
-    |"|":
-        sym := lxBAR
-
-    |"(":
-        sym := lxLROUND;
-
-        IF c = "*" THEN
-            sym := lxCOMMENT;
-            TXT.next(text);
-            comment(text)
-        END
-
-    |"[":
-        sym := lxLSQUARE
-
-    |"{":
-        sym := lxLCURLY
-
-    |"^":
-        sym := lxCARET
-
-    |"=":
-        sym := lxEQ
-
-    |"#":
-        sym := lxNE
-
-    |"<":
-        sym := lxLT;
-
-        IF c = "=" THEN
-            sym := lxLE;
-            TXT.next(text)
-        END
-
-    |">":
-        sym := lxGT;
-
-        IF c = "=" THEN
-            sym := lxGE;
-            TXT.next(text)
-        END
-
-    |":":
-        sym := lxCOLON;
-
-        IF c = "=" THEN
-            sym := lxASSIGN;
-            TXT.next(text)
-        END
-
-    |")":
-        sym := lxRROUND
-
-    |"]":
-        sym := lxRSQUARE
-
-    |"}":
-        sym := lxRCURLY
-
-    END
-
-    RETURN sym
-END delimiter;
-
-
-PROCEDURE Next* (text: SCANNER; VAR lex: LEX);
-VAR
-    c: CHAR;
-
-
-    PROCEDURE check (cond: BOOLEAN; text: SCANNER; lex: LEX; errno: INTEGER);
-    BEGIN
-        IF ~cond THEN
-            ERRORS.ErrorMsg(text.fname, lex.pos.line, lex.pos.col, errno)
-        END
-    END check;
-
-
-    PROCEDURE IsDef (str: ARRAY OF CHAR): BOOLEAN;
-    VAR
-        cur: DEF;
-
-    BEGIN
-        cur := def.first(DEF);
-        WHILE (cur # NIL) & (cur.ident # str) DO
-            cur := cur.next(DEF)
-        END
-
-        RETURN cur # NIL
-    END IsDef;
-
-
-    PROCEDURE Skip (text: SCANNER);
-    VAR
-        i: INTEGER;
-
-    BEGIN
-        i := 0;
-        WHILE (i <= text.ifc) & ~text._skip[i] DO
-            INC(i)
-        END;
-        text.skip := i <= text.ifc
-    END Skip;
-
-
-    PROCEDURE prep_if (text: SCANNER; VAR lex: LEX);
-    VAR
-        skip: BOOLEAN;
-
-    BEGIN
-        INC(text.ifc);
-        text._elsif[text.ifc] := lex.sym = lxELSIF;
-        IF lex.sym = lxIF THEN
-            INC(text.elsec);
-            text._else[text.elsec] := FALSE
-        END;
-        _if := TRUE;
-        skip := TRUE;
-        text.skip := FALSE;
-
-        Next(text, lex);
-        check(lex.sym = lxLROUND, text, lex, 64);
-
-        Next(text, lex);
-        check(lex.sym = lxIDENT, text, lex, 22);
-
-        REPEAT
-            IF IsDef(lex.ident.s) THEN
-                skip := FALSE
-            END;
-
-            Next(text, lex);
-            IF lex.sym = lxBAR THEN
-                Next(text, lex);
-                check(lex.sym = lxIDENT, text, lex, 22)
-            ELSE
-                check(lex.sym = lxRROUND, text, lex, 33)
-            END
-        UNTIL lex.sym = lxRROUND;
-
-        _if := FALSE;
-        text._skip[text.ifc] := skip;
-        Skip(text);
-        Next(text, lex)
-    END prep_if;
-
-
-    PROCEDURE prep_end (text: SCANNER; VAR lex: LEX);
-    BEGIN
-        check(text.ifc > 0, text, lex, 118);
-        IF lex.sym = lxEND THEN
-            WHILE text._elsif[text.ifc] DO
-                DEC(text.ifc)
-            END;
-            DEC(text.ifc);
-            DEC(text.elsec)
-        ELSIF (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN
-            check(~text._else[text.elsec], text, lex, 118);
-            text._skip[text.ifc] := ~text._skip[text.ifc];
-            text._else[text.elsec] := lex.sym = lxELSE
-        END;
-        Skip(text);
-        IF lex.sym = lxELSIF THEN
-            prep_if(text, lex)
-        ELSE
-            Next(text, lex)
-        END
-    END prep_end;
-
-
-BEGIN
-
-    REPEAT
-        c := text.peak;
-
-        WHILE S.space(c) DO
-            c := nextc(text)
-        END;
-
-        lex.pos.line := text.line;
-        lex.pos.col  := text.col;
-
-        IF S.letter(c) THEN
-            ident(text, lex)
-        ELSIF S.digit(c) THEN
-            number(text, lex)
-        ELSIF (c = '"') OR (c = "'") THEN
-            string(text, lex, c)
-        ELSIF delimiters[ORD(c)] THEN
-            lex.sym := delimiter(text, c)
-        ELSIF c = "$" THEN
-            IF S.letter(nextc(text)) THEN
-                ident(text, lex);
-                IF lex.sym = lxIF THEN
-                    IF ~_if THEN
-                        prep_if(text, lex)
-                    END
-                ELSIF (lex.sym = lxEND) OR (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN
-                    IF ~_if THEN
-                        prep_end(text, lex)
-                    END
-                ELSE
-                    check(FALSE, text, lex, 119)
-                END
-            ELSE
-                check(FALSE, text, lex, 119)
-            END
-        ELSIF c = 0X THEN
-            lex.sym := lxEOF;
-            text.skip := FALSE;
-            IF text.eof THEN
-                INC(lex.pos.col)
-            END
-        ELSIF (c = 7FX) & upto THEN
-            upto := FALSE;
-            lex.sym := lxRANGE;
-            DEC(lex.pos.col);
-            TXT.next(text)
-        ELSE
-            TXT.next(text);
-            lex.sym := lxERROR04
-        END;
-
-        IF lex.sym < 0 THEN
-            lex.error := -lex.sym
-        ELSE
-            lex.error := 0
-        END
-
-    UNTIL (lex.sym # lxCOMMENT) & ~text.skip
-
-END Next;
-
-
-PROCEDURE open* (name: ARRAY OF CHAR): SCANNER;
-    RETURN TXT.open(name)
-END open;
-
-
-PROCEDURE close* (VAR scanner: SCANNER);
-BEGIN
-    TXT.close(scanner)
-END close;
-
-
-PROCEDURE init* (lower: BOOLEAN);
-VAR
-    i: INTEGER;
-    delim: ARRAY 23 OF CHAR;
-
-BEGIN
-    upto := FALSE;
-    LowerCase := lower;
-
-    FOR i := 0 TO 255 DO
-        delimiters[i] := FALSE
-    END;
-
-    delim := "+-*/~&.,;|([{^=#<>:)]}";
-
-    FOR i := 0 TO LEN(delim) - 2 DO
-        delimiters[ORD(delim[i])] := TRUE
-    END;
-
-    enterKW("array",      0);
-    enterKW("begin",      1);
-    enterKW("by",         2);
-    enterKW("case",       3);
-    enterKW("const",      4);
-    enterKW("div",        5);
-    enterKW("do",         6);
-    enterKW("else",       7);
-    enterKW("elsif",      8);
-    enterKW("end",        9);
-    enterKW("false",     10);
-    enterKW("for",       11);
-    enterKW("if",        12);
-    enterKW("import",    13);
-    enterKW("in",        14);
-    enterKW("is",        15);
-    enterKW("mod",       16);
-    enterKW("module",    17);
-    enterKW("nil",       18);
-    enterKW("of",        19);
-    enterKW("or",        20);
-    enterKW("pointer",   21);
-    enterKW("procedure", 22);
-    enterKW("record",    23);
-    enterKW("repeat",    24);
-    enterKW("return",    25);
-    enterKW("then",      26);
-    enterKW("to",        27);
-    enterKW("true",      28);
-    enterKW("type",      29);
-    enterKW("until",     30);
-    enterKW("var",       31);
-    enterKW("while",     32)
-END init;
-
-
-PROCEDURE NewDef* (str: ARRAY OF CHAR);
-VAR
-    item: DEF;
-
-BEGIN
-    NEW(item);
-    COPY(str, item.ident);
-    LISTS.push(def, item)
-END NewDef;
-
-
-BEGIN
-    def := LISTS.create(NIL);
-    strings := LISTS.create(NIL)
-END SCAN.

programs/develop/oberon07/source/STRINGS.ob07

@@ -1,342 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE STRINGS;
-
-IMPORT UTILS;
-
-
-PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER);
-BEGIN
-    WHILE count > 0 DO
-        dst[dpos] := src[spos];
-        INC(spos);
-        INC(dpos);
-        DEC(count)
-    END
-END copy;
-
-
-PROCEDURE append* (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
-VAR
-    n1, n2: INTEGER;
-
-BEGIN
-    n1 := LENGTH(s1);
-    n2 := LENGTH(s2);
-
-    ASSERT(n1 + n2 < LEN(s1));
-
-    copy(s2, s1, 0, n1, n2);
-    s1[n1 + n2] := 0X
-END append;
-
-
-PROCEDURE IntToStr* (x: INTEGER; VAR str: ARRAY OF CHAR);
-VAR
-    i, a: INTEGER;
-
-BEGIN
-    IF x = UTILS.minint THEN
-        IF UTILS.bit_depth = 32 THEN
-            COPY("-2147483648", str)
-        ELSIF UTILS.bit_depth = 64 THEN
-            COPY("-9223372036854775808", str)
-        END
-
-    ELSE
-        i := 0;
-        IF x < 0 THEN
-            x := -x;
-            i := 1;
-            str[0] := "-"
-        END;
-
-        a := x;
-        REPEAT
-            INC(i);
-            a := a DIV 10
-        UNTIL a = 0;
-
-        str[i] := 0X;
-
-        REPEAT
-            DEC(i);
-            str[i] := CHR(x MOD 10 + ORD("0"));
-            x := x DIV 10
-        UNTIL x = 0
-    END
-END IntToStr;
-
-
-PROCEDURE search* (s: ARRAY OF CHAR; VAR pos: INTEGER; c: CHAR; forward: BOOLEAN);
-VAR
-    length: INTEGER;
-
-BEGIN
-    length := LENGTH(s);
-
-    IF (0 <= pos) & (pos < length) THEN
-        IF forward THEN
-            WHILE (pos < length) & (s[pos] # c) DO
-                INC(pos)
-            END;
-            IF pos = length THEN
-                pos := -1
-            END
-        ELSE
-            WHILE (pos >= 0) & (s[pos] # c) DO
-                DEC(pos)
-            END
-        END
-    ELSE
-        pos := -1
-    END
-END search;
-
-
-PROCEDURE replace* (VAR s: ARRAY OF CHAR; find, repl: CHAR);
-VAR
-    i, strlen: INTEGER;
-
-BEGIN
-    strlen := LENGTH(s) - 1;
-    FOR i := 0 TO strlen DO
-        IF s[i] = find THEN
-            s[i] := repl
-        END
-    END
-END replace;
-
-
-PROCEDURE trim* (source: ARRAY OF CHAR; VAR result: ARRAY OF CHAR);
-VAR
-    LenS, start, _end, i, j: INTEGER;
-
-BEGIN
-    LenS := LENGTH(source) - 1;
-    j := 0;
-    IF LenS >= 0 THEN
-        start := 0;
-        WHILE (start <= LenS) & (source[start] <= 20X) DO
-            INC(start)
-        END;
-
-        _end := LenS;
-        WHILE (_end >= 0) & (source[_end] <= 20X) DO
-            DEC(_end)
-        END;
-
-        FOR i := start TO _end DO
-            result[j] := source[i];
-            INC(j)
-        END
-    END;
-    result[j] := 0X
-END trim;
-
-
-PROCEDURE letter* (c: CHAR): BOOLEAN;
-    RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z") OR (c = "_")
-END letter;
-
-
-PROCEDURE digit* (c: CHAR): BOOLEAN;
-    RETURN ("0" <= c) & (c <= "9")
-END digit;
-
-
-PROCEDURE hexdigit* (c: CHAR): BOOLEAN;
-    RETURN ("0" <= c) & (c <= "9") OR ("A" <= c) & (c <= "F")
-END hexdigit;
-
-
-PROCEDURE space* (c: CHAR): BOOLEAN;
-    RETURN (0X < c) & (c <= 20X)
-END space;
-
-
-PROCEDURE cap* (VAR c: CHAR);
-BEGIN
-    IF ("a" <= c) & (c <= "z") THEN
-        c := CHR(ORD(c) - 32)
-    END
-END cap;
-
-
-PROCEDURE UpCase* (VAR str: ARRAY OF CHAR);
-VAR
-    i: INTEGER;
-
-BEGIN
-    i := LENGTH(str) - 1;
-    WHILE i >= 0 DO
-        cap(str[i]);
-        DEC(i)
-    END
-END UpCase;
-
-
-PROCEDURE StrToInt* (str: ARRAY OF CHAR; VAR x: INTEGER): BOOLEAN;
-VAR
-    i, k: INTEGER;
-    res: BOOLEAN;
-
-BEGIN
-    res := TRUE;
-    i := 0;
-    x := 0;
-    k := LENGTH(str);
-    WHILE i < k DO
-        IF digit(str[i]) THEN
-            x := x * 10 + ORD(str[i]) - ORD("0")
-        ELSE
-            i := k;
-            res := FALSE
-        END;
-        INC(i)
-    END
-
-    RETURN res
-END StrToInt;
-
-
-PROCEDURE CheckVer (str: ARRAY OF CHAR): BOOLEAN;
-VAR
-    i, k: INTEGER;
-    res: BOOLEAN;
-
-BEGIN
-    k := LENGTH(str);
-    res := k < LEN(str);
-
-    IF res & digit(str[0]) THEN
-        i := 0;
-        WHILE (i < k) & digit(str[i]) DO
-            INC(i)
-        END;
-        IF (i < k) & (str[i] = ".") THEN
-            INC(i);
-            IF i < k THEN
-                WHILE (i < k) & digit(str[i]) DO
-                    INC(i)
-                END
-            ELSE
-                res := FALSE
-            END
-        ELSE
-            res := FALSE
-        END;
-
-        res := res & (i = k)
-    ELSE
-        res := FALSE
-    END
-
-    RETURN res
-END CheckVer;
-
-
-PROCEDURE StrToVer* (str: ARRAY OF CHAR; VAR major, minor: INTEGER): BOOLEAN;
-VAR
-    i: INTEGER;
-    res: BOOLEAN;
-
-BEGIN
-    res := CheckVer(str);
-
-    IF res THEN
-        i := 0;
-        minor := 0;
-        major := 0;
-        WHILE digit(str[i]) DO
-            major := major * 10 + ORD(str[i]) - ORD("0");
-            INC(i)
-        END;
-        INC(i);
-        WHILE digit(str[i]) DO
-            minor := minor * 10 + ORD(str[i]) - ORD("0");
-            INC(i)
-        END
-    END
-
-    RETURN res
-END StrToVer;
-
-
-PROCEDURE Utf8To16* (src: ARRAY OF CHAR; VAR dst: ARRAY OF WCHAR): INTEGER;
-VAR
-    i, j, u, srclen, dstlen: INTEGER;
-    c: CHAR;
-
-BEGIN
-    srclen := LEN(src);
-    dstlen := LEN(dst);
-    i := 0;
-    j := 0;
-    WHILE (i < srclen) & (j < dstlen) & (src[i] # 0X) DO
-        c := src[i];
-        CASE c OF
-        |00X..7FX:
-            u := ORD(c)
-
-        |0C1X..0DFX:
-            u := (ORD(c) - 0C0H) * 64;
-            IF i + 1 < srclen THEN
-                INC(i);
-                INC(u, ORD(src[i]) MOD 64)
-            END
-
-        |0E1X..0EFX:
-            u := (ORD(c) - 0E0H) * 4096;
-            IF i + 1 < srclen THEN
-                INC(i);
-                INC(u, (ORD(src[i]) MOD 64) * 64)
-            END;
-            IF i + 1 < srclen THEN
-                INC(i);
-                INC(u, ORD(src[i]) MOD 64)
-            END
-(*
-        |0F1X..0F7X:
-        |0F9X..0FBX:
-        |0FDX:
-        *)
-        ELSE
-        END;
-        INC(i);
-        dst[j] := WCHR(u);
-        INC(j)
-    END;
-    IF j < dstlen THEN
-        dst[j] := WCHR(0)
-    END
-
-    RETURN j
-END Utf8To16;
-
-
-PROCEDURE HashStr* (name: ARRAY OF CHAR): INTEGER;
-VAR
-    i, h: INTEGER;
-    g: SET;
-
-BEGIN
-    h := 0;
-    i := 0;
-    WHILE name[i] # 0X DO
-        h := h * 16 + ORD(name[i]);
-        g := BITS(h) * {28..31};
-        h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g);
-        INC(i)
-    END
-
-    RETURN h
-END HashStr;
-
-
-END STRINGS.

programs/develop/oberon07/source/TARGETS.ob07

@@ -1,154 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2019-2021, 2023, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE TARGETS;
-
-IMPORT UTILS;
-
-
-CONST
-
-    MSP430*       =  0;
-    Win32C*       =  1;
-    Win32GUI*     =  2;
-    Win32DLL*     =  3;
-    KolibriOS*    =  4;
-    KolibriOSDLL* =  5;
-    Win64C*       =  6;
-    Win64GUI*     =  7;
-    Win64DLL*     =  8;
-    Linux32*      =  9;
-    Linux32SO*    = 10;
-    Linux64*      = 11;
-    Linux64SO*    = 12;
-    STM32CM3*     = 13;
-    RVM32I*       = 14;
-    RVM64I*       = 15;
-
-    cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3;
-    cpuRVM32I* = 4; cpuRVM64I* = 5;
-
-    osNONE*    = 0;  osWIN32*   = 1;  osWIN64* = 2;
-    osLINUX32* = 3;  osLINUX64* = 4;  osKOS*   = 5;
-
-    noDISPOSE = {MSP430, STM32CM3, RVM32I, RVM64I};
-
-    noRTL = {MSP430};
-
-    libRVM32I = "RVMxI" + UTILS.slash + "32";
-    libRVM64I = "RVMxI" + UTILS.slash + "64";
-
-
-TYPE
-
-    STRING = ARRAY 32 OF CHAR;
-
-    TARGET = RECORD
-
-        target, CPU, OS, RealSize: INTEGER;
-        ComLinePar*, LibDir, FileExt: STRING
-
-    END;
-
-
-VAR
-
-    Targets*: ARRAY 16 OF TARGET;
-
-    CPUs: ARRAY 6 OF
-        RECORD
-            BitDepth, InstrSize: INTEGER;
-            LittleEndian: BOOLEAN
-        END;
-
-    target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*, InstrSize*: INTEGER;
-    ComLinePar*, LibDir*, FileExt*: STRING;
-    Import*, Dispose*, RTL*, Dll*, LittleEndian*, WinLin*: BOOLEAN;
-
-
-PROCEDURE Enter (idx, CPU, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING);
-BEGIN
-    Targets[idx].target := idx;
-    Targets[idx].CPU := CPU;
-    Targets[idx].RealSize := RealSize;
-    Targets[idx].OS := OS;
-    Targets[idx].ComLinePar := ComLinePar;
-    Targets[idx].LibDir := LibDir;
-    Targets[idx].FileExt := FileExt;
-END Enter;
-
-
-PROCEDURE Select* (ComLineParam: ARRAY OF CHAR): BOOLEAN;
-VAR
-    i: INTEGER;
-    res: BOOLEAN;
-
-BEGIN
-    i := 0;
-    WHILE (i < LEN(Targets)) & (Targets[i].ComLinePar # ComLineParam) DO
-        INC(i)
-    END;
-
-    res := i < LEN(Targets);
-    IF res THEN
-        target := Targets[i].target;
-        CPU := Targets[i].CPU;
-        BitDepth := CPUs[CPU].BitDepth;
-        InstrSize := CPUs[CPU].InstrSize;
-        LittleEndian := CPUs[CPU].LittleEndian;
-        RealSize := Targets[i].RealSize;
-        OS := Targets[i].OS;
-        ComLinePar := Targets[i].ComLinePar;
-        LibDir := Targets[i].LibDir;
-        FileExt := Targets[i].FileExt;
-
-        Import := OS IN {osWIN32, osWIN64, osKOS};
-        Dispose := ~(target IN noDISPOSE);
-        RTL := ~(target IN noRTL);
-        Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL};
-        WinLin := OS IN {osWIN32, osLINUX32, osWIN64, osLINUX64};
-        WordSize := BitDepth DIV 8;
-        AdrSize  := WordSize
-    END
-
-    RETURN res
-END Select;
-
-
-PROCEDURE EnterCPU (cpu, BitDepth, InstrSize: INTEGER; LittleEndian: BOOLEAN);
-BEGIN
-    CPUs[cpu].BitDepth := BitDepth;
-    CPUs[cpu].InstrSize := InstrSize;
-    CPUs[cpu].LittleEndian := LittleEndian
-END EnterCPU;
-
-
-BEGIN
-    EnterCPU(cpuX86,    32, 1, TRUE);
-    EnterCPU(cpuAMD64,  64, 1, TRUE);
-    EnterCPU(cpuMSP430, 16, 2, TRUE);
-    EnterCPU(cpuTHUMB,  32, 2, TRUE);
-    EnterCPU(cpuRVM32I, 32, 4, TRUE);
-    EnterCPU(cpuRVM64I, 64, 8, TRUE);
-
-    Enter( MSP430,        cpuMSP430,  0,  osNONE,     "msp430",      "MSP430",    ".hex");
-    Enter( Win32C,        cpuX86,     8,  osWIN32,    "win32con",    "Windows",   ".exe");
-    Enter( Win32GUI,      cpuX86,     8,  osWIN32,    "win32gui",    "Windows",   ".exe");
-    Enter( Win32DLL,      cpuX86,     8,  osWIN32,    "win32dll",    "Windows",   ".dll");
-    Enter( KolibriOS,     cpuX86,     8,  osKOS,      "kosexe",      "KolibriOS", "");
-    Enter( KolibriOSDLL,  cpuX86,     8,  osKOS,      "kosdll",      "KolibriOS", ".obj");
-    Enter( Win64C,        cpuAMD64,   8,  osWIN64,    "win64con",    "Windows",   ".exe");
-    Enter( Win64GUI,      cpuAMD64,   8,  osWIN64,    "win64gui",    "Windows",   ".exe");
-    Enter( Win64DLL,      cpuAMD64,   8,  osWIN64,    "win64dll",    "Windows",   ".dll");
-    Enter( Linux32,       cpuX86,     8,  osLINUX32,  "linux32exe",  "Linux",     "");
-    Enter( Linux32SO,     cpuX86,     8,  osLINUX32,  "linux32so",   "Linux",     ".so");
-    Enter( Linux64,       cpuAMD64,   8,  osLINUX64,  "linux64exe",  "Linux",     "");
-    Enter( Linux64SO,     cpuAMD64,   8,  osLINUX64,  "linux64so",   "Linux",     ".so");
-    Enter( STM32CM3,      cpuTHUMB,   4,  osNONE,     "stm32cm3",    "STM32CM3",  ".hex");
-    Enter( RVM32I,        cpuRVM32I,  4,  osNONE,     "rvm32i",      libRVM32I,   ".bin");
-    Enter( RVM64I,        cpuRVM64I,  8,  osNONE,     "rvm64i",      libRVM64I,   ".bin");
-END TARGETS.

programs/develop/oberon07/source/TEXTDRV.ob07

@@ -1,210 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE TEXTDRV;
-
-IMPORT FILES, C := COLLECTIONS;
-
-
-CONST
-
-    CR = 0DX; LF = 0AX; HT = 9X;
-
-    CHUNK = 1024 * 256;
-
-    defTabSize* = 4;
-
-
-TYPE
-
-    TEXT* = POINTER TO RECORD (C.ITEM)
-
-        chunk:        ARRAY CHUNK OF CHAR;
-        pos, size:    INTEGER;
-        file:         FILES.FILE;
-        utf8:         BOOLEAN;
-        CR:           BOOLEAN;
-
-        line*, col*:  INTEGER;
-        ifc*:         INTEGER;
-        elsec*:       INTEGER;
-        eof*:         BOOLEAN;
-        eol*:         BOOLEAN;
-        skip*:        BOOLEAN;
-        peak*:        CHAR;
-        _skip*,
-        _elsif*,
-        _else*:       ARRAY 100 OF BOOLEAN;
-        fname*:       ARRAY 2048 OF CHAR
-
-    END;
-
-
-VAR
-
-    texts: C.COLLECTION;
-    TabSize: INTEGER;
-
-
-PROCEDURE load (text: TEXT);
-BEGIN
-    IF ~text.eof THEN
-        text.size := FILES.read(text.file, text.chunk, LEN(text.chunk));
-        text.pos := 0;
-        IF text.size = 0 THEN
-            text.eof := TRUE;
-            text.chunk[0] := 0X
-        END;
-        text.peak := text.chunk[0]
-    END
-END load;
-
-
-PROCEDURE next* (text: TEXT);
-VAR
-    c: CHAR;
-
-BEGIN
-    IF text.pos < text.size - 1 THEN
-        INC(text.pos);
-        text.peak := text.chunk[text.pos]
-    ELSE
-        load(text)
-    END;
-
-    IF ~text.eof THEN
-
-        c := text.peak;
-
-        IF c = CR THEN
-            INC(text.line);
-            text.col := 0;
-            text.eol := TRUE;
-            text.CR  := TRUE
-        ELSIF c = LF THEN
-            IF ~text.CR THEN
-                INC(text.line);
-                text.col := 0;
-                text.eol := TRUE
-            ELSE
-                text.eol := FALSE
-            END;
-            text.CR := FALSE
-        ELSIF c = HT THEN
-            text.col := text.col + TabSize - text.col MOD TabSize;
-            text.eol := FALSE;
-            text.CR  := FALSE
-        ELSE
-            IF text.utf8 THEN
-                IF ORD(c) DIV 64 # 2 THEN
-                    INC(text.col)
-                END
-            ELSE
-                INC(text.col)
-            END;
-            text.eol := FALSE;
-            text.CR  := FALSE
-        END
-
-    END
-
-END next;
-
-
-PROCEDURE init (text: TEXT);
-BEGIN
-    IF (text.pos = 0) & (text.size >= 3) THEN
-        IF (text.chunk[0] = 0EFX) &
-           (text.chunk[1] = 0BBX) &
-           (text.chunk[2] = 0BFX) THEN
-            text.pos := 3;
-            text.utf8 := TRUE
-        END
-    END;
-
-    IF text.size = 0 THEN
-        text.chunk[0] := 0X;
-        text.size := 1;
-        text.eof := FALSE
-    END;
-
-    text.line := 1;
-    text.col  := 1;
-
-    text.peak := text.chunk[text.pos]
-END init;
-
-
-PROCEDURE close* (VAR text: TEXT);
-BEGIN
-    IF text # NIL THEN
-        IF text.file # NIL THEN
-            FILES.close(text.file)
-        END;
-
-        C.push(texts, text);
-        text := NIL
-    END
-END close;
-
-
-PROCEDURE open* (name: ARRAY OF CHAR): TEXT;
-VAR
-    text: TEXT;
-    citem: C.ITEM;
-
-BEGIN
-    citem := C.pop(texts);
-    IF citem = NIL THEN
-        NEW(text)
-    ELSE
-        text := citem(TEXT)
-    END;
-
-    IF text # NIL THEN
-        text.chunk[0] := 0X;
-        text.pos  := 0;
-        text.size := 0;
-        text.utf8 := FALSE;
-        text.CR   := FALSE;
-        text.line := 1;
-        text.col  := 1;
-        text.eof  := FALSE;
-        text.eol  := FALSE;
-        text.skip := FALSE;
-        text.ifc  := 0;
-        text.elsec := 0;
-        text._skip[0] := FALSE;
-        text.peak := 0X;
-        text.file := FILES.open(name);
-        COPY(name, text.fname);
-        IF text.file # NIL THEN
-            load(text);
-            init(text)
-        ELSE
-            close(text)
-        END
-    END
-
-    RETURN text
-END open;
-
-
-PROCEDURE setTabSize* (n: INTEGER);
-BEGIN
-    IF (0 < n) & (n <= 64) THEN
-        TabSize := n
-    ELSE
-        TabSize := defTabSize
-    END
-END setTabSize;
-
-
-BEGIN
-    TabSize := defTabSize;
-    texts := C.create()
-END TEXTDRV.

programs/develop/oberon07/source/UTILS.ob07

@@ -1,217 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2023, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE UTILS;
-
-IMPORT HOST;
-
-
-CONST
-
-    slash* = HOST.slash;
-    eol* = HOST.eol;
-
-    bit_depth* = HOST.bit_depth;
-    maxint* = HOST.maxint;
-    minint* = HOST.minint;
-
-    min32* = -2147483647-1;
-    max32* =  2147483647;
-
-    vMajor* = 1;
-    vMinor* = 64;
-    Date* = "22-jan-2023";
-
-    FILE_EXT* = ".ob07";
-    RTL_NAME* = "RTL";
-
-    MAX_GLOBAL_SIZE* = 1600000000;
-
-
-VAR
-
-    time*: INTEGER;
-
-    maxreal*, inf*: REAL;
-
-    target*:
-
-      RECORD
-
-          bit_depth*,
-          maxInt*,
-          minInt*,
-          maxSet*,
-          maxHex*:    INTEGER;
-
-          maxReal*:   REAL
-
-      END;
-
-    bit_diff*: INTEGER;
-
-
-PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
-    RETURN HOST.FileRead(F, Buffer, bytes)
-END FileRead;
-
-
-PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
-    RETURN HOST.FileWrite(F, Buffer, bytes)
-END FileWrite;
-
-
-PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
-    RETURN HOST.FileCreate(FName)
-END FileCreate;
-
-
-PROCEDURE FileClose* (F: INTEGER);
-BEGIN
-    HOST.FileClose(F)
-END FileClose;
-
-
-PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
-    RETURN HOST.FileOpen(FName)
-END FileOpen;
-
-
-PROCEDURE chmod* (FName: ARRAY OF CHAR);
-BEGIN
-    HOST.chmod(FName)
-END chmod;
-
-
-PROCEDURE GetArg* (i: INTEGER; VAR str: ARRAY OF CHAR);
-BEGIN
-    HOST.GetArg(i, str)
-END GetArg;
-
-
-PROCEDURE Exit* (code: INTEGER);
-BEGIN
-    HOST.ExitProcess(code)
-END Exit;
-
-
-PROCEDURE GetTickCount* (): INTEGER;
-    RETURN HOST.GetTickCount()
-END GetTickCount;
-
-
-PROCEDURE OutChar* (c: CHAR);
-BEGIN
-    HOST.OutChar(c)
-END OutChar;
-
-
-PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
-    RETURN HOST.splitf(x, a, b)
-END splitf;
-
-
-PROCEDURE d2s* (x: REAL): INTEGER;
-    RETURN HOST.d2s(x)
-END d2s;
-
-
-PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
-    RETURN HOST.isRelative(path)
-END isRelative;
-
-
-PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
-BEGIN
-    HOST.GetCurrentDirectory(path)
-END GetCurrentDirectory;
-
-
-PROCEDURE UnixTime* (): INTEGER;
-    RETURN HOST.UnixTime()
-END UnixTime;
-
-
-PROCEDURE SetBitDepth* (BitDepth: INTEGER; Double: BOOLEAN);
-BEGIN
-    ASSERT((BitDepth = 16) OR (BitDepth = 32) OR (BitDepth = 64));
-    bit_diff := bit_depth - BitDepth;
-    ASSERT(bit_diff >= 0);
-
-    target.bit_depth := BitDepth;
-    target.maxSet    := BitDepth - 1;
-    target.maxHex    := BitDepth DIV 4;
-    target.minInt    := ASR(minint, bit_diff);
-    target.maxInt    := ASR(maxint, bit_diff);
-
-    IF Double THEN
-        target.maxReal := maxreal
-    ELSE
-        target.maxReal := 1.9;
-        PACK(target.maxReal, 127)
-    END
-END SetBitDepth;
-
-
-PROCEDURE Byte* (n: INTEGER; idx: INTEGER): BYTE;
-    RETURN ASR(n, 8 * idx) MOD 256
-END Byte;
-
-
-PROCEDURE Align* (VAR bytes: INTEGER; align: INTEGER): BOOLEAN;
-BEGIN
-    INC(bytes, (-bytes) MOD align)
-    RETURN bytes >= 0
-END Align;
-
-
-PROCEDURE Long* (value: INTEGER): INTEGER;
-    RETURN ASR(LSL(value, bit_diff), bit_diff)
-END Long;
-
-
-PROCEDURE Short* (value: INTEGER): INTEGER;
-    RETURN LSR(LSL(value, bit_diff), bit_diff)
-END Short;
-
-
-PROCEDURE Log2* (x: INTEGER): INTEGER;
-VAR
-    n: INTEGER;
-
-BEGIN
-    n := 0;
-    WHILE ~ODD(x) DO
-        x := x DIV 2;
-        INC(n)
-    END;
-
-    IF x # 1 THEN
-        n := -1
-    END
-
-    RETURN n
-END Log2;
-
-
-PROCEDURE hexdgt* (n: BYTE): BYTE;
-BEGIN
-    IF n < 10 THEN
-        INC(n, ORD("0"))
-    ELSE
-        INC(n, ORD("A") - 10)
-    END
-
-    RETURN n
-END hexdgt;
-
-
-BEGIN
-    time := HOST.GetTickCount();
-    inf := HOST.inf;
-    maxreal := HOST.maxreal
-END UTILS.

programs/develop/oberon07/source/WRITER.ob07

@@ -1,104 +0,0 @@
-(*
-    BSD 2-Clause License
-
-    Copyright (c) 2018-2021, Anton Krotov
-    All rights reserved.
-*)
-
-MODULE WRITER;
-
-IMPORT FILES, ERRORS, UTILS;
-
-
-VAR
-
-    counter*: INTEGER;
-    file: FILES.FILE;
-
-
-PROCEDURE align* (n, _align: INTEGER): INTEGER;
-BEGIN
-    ASSERT(UTILS.Align(n, _align))
-    RETURN n
-END align;
-
-
-PROCEDURE WriteByte* (n: BYTE);
-BEGIN
-    IF FILES.WriteByte(file, n) THEN
-        INC(counter)
-    ELSE
-        ERRORS.Error(201)
-    END
-END WriteByte;
-
-
-PROCEDURE Write* (chunk: ARRAY OF BYTE; bytes: INTEGER);
-VAR
-    n: INTEGER;
-
-BEGIN
-    n := FILES.write(file, chunk, bytes);
-    IF n # bytes THEN
-        ERRORS.Error(201)
-    END;
-    INC(counter, n)
-END Write;
-
-
-PROCEDURE Write64LE* (n: INTEGER);
-VAR
-    i: INTEGER;
-
-BEGIN
-    FOR i := 0 TO 7 DO
-        WriteByte(UTILS.Byte(n, i))
-    END
-END Write64LE;
-
-
-PROCEDURE Write32LE* (n: INTEGER);
-VAR
-    i: INTEGER;
-
-BEGIN
-    FOR i := 0 TO 3 DO
-        WriteByte(UTILS.Byte(n, i))
-    END
-END Write32LE;
-
-
-PROCEDURE Write16LE* (n: INTEGER);
-BEGIN
-    WriteByte(UTILS.Byte(n, 0));
-    WriteByte(UTILS.Byte(n, 1))
-END Write16LE;
-
-
-PROCEDURE Padding* (FileAlignment: INTEGER);
-VAR
-    i: INTEGER;
-
-BEGIN
-    i := align(counter, FileAlignment) - counter;
-    WHILE i > 0 DO
-        WriteByte(0);
-        DEC(i)
-    END
-END Padding;
-
-
-PROCEDURE Create* (FileName: ARRAY OF CHAR);
-BEGIN
-    counter := 0;
-    file := FILES.create(FileName)
-END Create;
-
-
-PROCEDURE Close*;
-BEGIN
-    FILES.close(file)
-END Close;
-
-
-END WRITER.

programs/network/ftpd/commands.inc

@@ -84,8 +84,9 @@ commands:               ; all commands must be in uppercase
 ;        dd 'APPE', login_first, login_first, login_first, cmd_APPE
         dd 'CDUP', login_first, login_first, login_first, cmdCDUP
         dd 'CWD',  login_first, login_first, login_first, cmdCWD
+        dd 'XCWD',  login_first, login_first, login_first, cmdCWD
         dd 'DELE', login_first, login_first, login_first, cmdDELE
-;        dd 'HELP', login_first, login_first, login_first, cmd_HELP
+        dd 'HELP', login_first, login_first, login_first, cmdHELP
         dd 'LIST', login_first, login_first, login_first, cmdLIST
 ;        dd 'MDTM', login_first, login_first, login_first, cmd_MDTM
 ;        dd 'MKD',  login_first, login_first, login_first, cmd_MKD
@@ -96,6 +97,7 @@ commands:               ; all commands must be in uppercase
         dd 'PASV', login_first, login_first, login_first, cmdPASV
         dd 'PORT', login_first, login_first, login_first, cmdPORT
         dd 'PWD',  login_first, login_first, login_first, cmdPWD
+        dd 'XPWD',  login_first, login_first, login_first, cmdPWD
         dd 'QUIT', cmdQUIT,     cmdQUIT,     cmdQUIT,     cmdQUIT
 ;        dd 'REIN', login_first, login_first, login_first, cmd_REIN
 ;        dd 'REST', login_first, login_first, login_first, cmd_REST
@@ -342,7 +344,7 @@ align 4
 cmdABOR:
 
         or      [ebp + thread_data.permissions], ABORT
-        sendFTP "250 Command succesul"
+        sendFTP "250 Command successful"
         ret
 
 ;------------------------------------------------
@@ -383,7 +385,7 @@ cmdCDUP:
         invoke  con_write_asciiz, eax
         invoke  con_write_asciiz, str_newline
 
-        sendFTP "250 Command succesul"
+        sendFTP "250 Command successful"
         ret
 
 ;------------------------------------------------
@@ -448,7 +450,7 @@ cmdCWD:
         invoke  con_write_asciiz, eax
         invoke  con_write_asciiz, str_newline
 
-        sendFTP "250 Command succesful"
+        sendFTP "250 Command successful"
         ret
 
   .err:
@@ -510,7 +512,7 @@ cmdDELE:
         test    eax, eax
         jnz     .err
 
-        sendFTP "250 Command succesful"
+        sendFTP "250 Command successful"
         ret
 .err:
         sendFTP "550 No such file"
@@ -1245,6 +1247,68 @@ cmdTYPE:
         sendFTP "200 Command ok"
         ret
 
+;------------------------------------------------
+; "HELP"
+;
+; Provide help information.
+;
+;------------------------------------------------
+align 4
+cmdHELP:
+
+        lea     edi, [ebp + thread_data.buffer]
+        mov     eax, '214 '
+        stosd
+        mov     eax, 'Help'
+        stosd
+        mov     ax, ': '
+        stosw
+        
+        mov     esi, commands               ; pointer to commands table
+        
+.next_command:
+        cmp     byte [esi], 0               ; end of table?
+        je      .list_done
+        
+        ; Copy command name (4 bytes), skip null bytes
+        mov     ecx, 4
+.copy_name:
+        mov     al, [esi]
+        test    al, al
+        jz      .skip_null
+        stosb
+.skip_null:
+        inc     esi
+        loop    .copy_name
+        
+        ; Add space after command name
+        mov     al, ' '
+        stosb
+        
+        ; Skip the four address pointers (16 bytes)
+        add     esi, 16
+        jmp     .next_command
+        
+.list_done:
+        ; Remove trailing space (if any)
+        dec     edi
+        ; Add CRLF
+        mov     ax, 0x0a0d                  ; \r\n
+        stosw
+        xor     al, al                      ; null terminator
+        stosb
+        
+        ; Calculate length
+        lea     edx, [ebp + thread_data.buffer]
+        sub     edi, edx
+
+        ; Send response
+        mcall   send, [ebp + thread_data.socketnum], edx, edi
+        ; Also log to console
+        invoke  con_write_asciiz, edx
+        
+        ret
+
 ;------------------------------------------------
 ; "USER"
 ;

programs/network/ftpd/ftpd.asm

@@ -135,7 +135,7 @@ start:
         mov     [sockaddr1.port], ax
 
         xchg    al, ah
-        invoke  con_printf, str1, eax
+        invoke  con_printf, str1, ini_buf, eax
         add     esp, 8
 
 ; open listening socket
@@ -341,7 +341,7 @@ thread_exit:
 ; initialized data
 
 title           db 'FTP daemon', 0
-str1            db 'Starting FTP daemon on port %u.', 0
+str1            db 'Starting FTP daemon on %s:%u', 0
 str2            db '.', 0
 str2b           db ' OK!',10,0
 str3            db 'Listen error',10,0

programs/use_ob07.lua

@@ -0,0 +1,6 @@
+OB07 = tup.getcwd() .. "/develop/oberon07/compiler"
+OB07_FLAGS = "-stk 1 -nochk a"
+
+function build_ob07(input, output)
+  tup.rule(input, OB07 .. " %f kosexe -out %o " .. OB07_FLAGS .. " " .. tup.getconfig("KPACK_CMD"),  output)
+end

tup.config.template

@@ -21,6 +21,7 @@
 # CONFIG_NO_MSVC=full
 # CONFIG_NO_CMM=full
 # CONFIG_NO_TCC=full
+# CONFIG_NO_OB07=full
 ### Path to gcc toolchain library with -lgcc.
 ### Normally, you should not modify it,
 ### since the toolchain assumes the fixed path anyway.