├── README.md ├── coredump.txt ├── kernel7.img ├── risc-boot.inc ├── risccore.pas ├── riscfp.pas ├── riscglob.pas ├── riscpas.pas ├── riscps2.pas ├── riscsd.pas └── ultiboberont.lpr /README.md: -------------------------------------------------------------------------------- 1 | # Port of the OBERON RISC Emulator to Ultibo 2 | ============================================ 3 | Port this program to [Ultibo](http://www.ultibo.org) 4 | 5 | ## For the Oberonians: 6 | -------------------- 7 | 8 | ### What is Ultibo ? 9 | 10 | citation from the Ultibo web-site: 11 | 12 | "Ultibo core is an embedded or bare metal development environment for Raspberry Pi. 13 | It is not an operating system but provides many of the same services as an OS, 14 | things like memory management, networking, filesystems and threading plus 15 | much more." 16 | 17 | What they write only in the footnote is: 18 | 19 | "Ultibo is written entirely in Free Pascal and is designed to act as a unikernel 20 | or a kernel in a run time library. That means when you compile your application 21 | the necessary parts of Ultibo are automatically included by the compiler so 22 | that your program runs without needing an operating system." 23 | 24 | For all, not yet knowing what the Raspberry Pi is: 25 | 26 | ### What is the Raspberry Pi ? 27 | "The Raspberry Pi is a series of credit card-sized single-board computers 28 | developed in the United Kingdom by the Raspberry Pi Foundation to promote the 29 | teaching of basic computer science in schools and developing countries" 30 | https://en.wikipedia.org/wiki/Raspberry_Pi 31 | 32 | And the most important thing: The RPI is cheap: 33 | The smallest model costs here in Germany incl. tax 15 EUR, the biggest iron 34 | 38 EUR. Here we have 4 ARM cores @ 1 GHz, HDMI, USB, Network interface, PIO, LED,audio, etc. etc. + 1 GByte + SD card etc. 35 | 36 | The RPI is mostly used with LINUX. That's nice but with LINUX you are far, far 37 | away from the hardware. And its quite crazy for my opinion, to use Gigabytes 38 | of code to blink a LED. 39 | 40 | ###So what is Ultibo for me: 41 | The ideal tool! You have more or less infinite RAM and power, 42 | you can and MUST write all programs in PASCAL, and you have with Lazarus 43 | a real nice and fast development environment for Windows and Linux (with Wine) 44 | 45 | 46 | ## For the Ultiboys and Ultigirls: 47 | 48 | ### What is OBERON: 49 | 1. OBERON is a programming language designed from 1988 by the Turing award winner Niklaus Wirth, the inventor of PASCAL and some other programming languages. 50 | OBERON is quite similar to PASCAL with object extension and units as known from 51 | Turbo Pascal 6.0+. 52 | 2. OBERON is also, and that's sometimes confusing, the name of a complete operating system, including graphical user interface with mouse control, an editor, compiler, libraries etc. 53 | Wirth was 1977/78 at the XEROX park labs in Palo Alto, where he worked with the 54 | ALTO workstation. This was the first computer with a mouse and a graphical user 55 | interface. In 1986 Wirth developed his own 32bit computer called CERES incl. 56 | his own operating system written in his own language called OBERON. 57 | From 2013 Wirth was developing a new workstation based on one single FPGA and called it 58 | __Project OBERON__. See http://www.projectoberon.com/ or 59 | http://www.xilinx.com/support/documentation/xcell_articles/91-5-oberon-system-implemented-on-a-low-cost-fpga-board.pdf 60 | or 61 | https://www.computer.org/csdl/mags/co/2012/07/mco2012070008.pdf 62 | 63 | The complete system including the kernel, the editor, the compiler and the GUI 64 | has about 10000 (ten thousand) lines of code. The Linux 4.x kernel has about 15 million lines of code. 65 | 66 | 67 | 68 | ## For both: 69 | Project Oberon aka FPGA OBERON is a very interesting system, but fiddling around with FPGAs, especially with the development environments of Xilinx or Altera is, friendly spoken, demanding. Even producing a video signal for a modern interface like HDMI or display port with a FPGA is for example 10 times more complex then the whole so called RISC5 processor for the Project OBERON. 70 | 71 | In 2014 Peter de Wachter has written an emulator for Project OBERON on the PC. 72 | A nice project, but written in C, a non-Wirthian languge. So i made a port of his program to (Free)-Pascal. The emulator works fine, but making the graphic 73 | and the mouse interface with the SDL library was a typical example for the 74 | complexity of Linux and Windows. 75 | 76 | ## My intension to bring OBERON to Ultibo on the RPI: 77 | 78 | 0. Having a total type save Wirthian system! 79 | 1. A proof of concept and test for Ultibo. 80 | 2. Having an OBERON system for 15 EUR 81 | 3. Having direct hardware access from OBERON. Up to now only the Blink.Run works, but integrate GPIO, the serial interface etc. may be done with only a few 82 | lines of code. 83 | 4. Its quite easy to expand OBERON with some TCP/IP functionality, which is already part of the Ultibo libraries. 84 | 5. Maybe in the future OBERON can be used as a kind of inelligent shell, including 85 | editor, compiler etc. for Ultibo. 86 | 87 | # Hints, Design, Problems etc. 88 | 1. The software is __pre-beta__! 89 | 2. There is a bug in the USB interface in Ultibo. You __must__ use an USB hub to connect mouse and keyboard. At least one of both must be connected via the hub. 90 | There seems to be a DMA problem for slow HID devices. Its a known issue. 91 | 3. Due to lack of time, I have the code only tested for the RPI2. 92 | 4. I have realised the sw in one single thread follwing Wirths original design. 93 | 5. The code is not optimized for performance at all. 94 | 6. The RISC5 code and the FPU code is from 2014, the latest FPU improvements 95 | etc. are not coded yet. 96 | 7. The OBERON file system is encapsulated in one single file oberon.dsk, it 97 | would be nice for sure, to mirror it in FAT or similar. 98 | 8. The disk image is from Peter de Wachter at: 99 | https://github.com/pdewacht/oberon-risc-emu/blob/master/DiskImage/Oberon-2016-08-02.dsk 100 | 9. Ultibo has no command line options, so everything is hard coded. 101 | 10. the F4 and F12 keys are not working yet. 102 | 11. For Non-Oberonians: Before you play with the software please read: 103 | https://www.inf.ethz.ch/personal/wirth/ProjectOberon/UsingOberon.pdf 104 | The using of the mouse and the windows (here called viewers) is different 105 | from the Windows or OsX world. Even if Allen, Wozniak, Gates and Jobs said that 106 | they have been at least "inspired" by the ALTO system they had seen at Xerox. 107 | 12. You need a 3 button mouse. 108 | 13. .. and many more.. 109 | 14. Only tested with a 1280 x 1024 screen 110 | 111 | #Licenses 112 | 113 | #Licenses 114 | Copyright: (c) Markus Greim, August 2016 115 | Permission to use, copy, modify, and/or distribute this software for 116 | any purpose with or without fee is hereby granted, provided that the 117 | below copyright notice and this permission notice appear in all 118 | copies. 119 | 120 | ##Ultibo 121 | core is licensed under the GNU Lesser General Public License v2.1 and is 122 | freely available to use, modify and distribute within the terms of the license. 123 | The license includes an exception statement to permit static linking with files 124 | that are licensed under different terms. 125 | 126 | ##Free-Pascal 127 | http://www.freepascal.org/faq.var#general-license 128 | 129 | ##Oberon 130 | Project Oberon, Revised Edition 2013 131 | 132 | Book copyright (C)2013 Niklaus Wirth and Juerg Gutknecht; 133 | software copyright (C)2013 Niklaus Wirth (NW), Juerg Gutknecht (JG), Paul 134 | Reed (PR/PDR). 135 | 136 | Permission to use, copy, modify, and/or distribute this software and its 137 | accompanying documentation (the "Software") for any purpose with or 138 | without fee is hereby granted, provided that the above copyright notice 139 | and this permission notice appear in all copies. 140 | 141 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHORS DISCLAIM ALL WARRANTIES 142 | WITH REGARD TO THE SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF 143 | MERCHANTABILITY, FITNESS AND NONINFRINGEMENT. IN NO EVENT SHALL THE 144 | AUTHORS BE LIABLE FOR ANY CLAIM, SPECIAL, DIRECT, INDIRECT, OR 145 | CONSEQUENTIAL DAMAGES OR ANY DAMAGES OR LIABILITY WHATSOEVER, WHETHER IN 146 | AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 147 | CONNECTION WITH THE DEALINGS IN OR USE OR PERFORMANCE OF THE SOFTWARE. 148 | 149 | 150 | ##All other copyright things below, I hope. 151 | 152 | Below the Radme file of the original port: 153 | 154 | Oberon RISC Emulator for Pascal 155 | =============================== 156 | 157 | translation of the Oberon Risc Emulator from 158 | Peter De Wachter to Freepascal. 159 | 160 | I was using: 161 | 162 | SDL2 headers translation for Free Pascal 163 | https://bitbucket.org/p_daniel/sdl-2-for-free-pascal-compiler 164 | from P. Daniel 165 | 166 | SDL 167 | Simple DirectMedia Layer 168 | Copyright (C) 1997-2013 Sam Lantinga 169 | [SDL2](http://libsdl.org/). 170 | 171 | The Oberon bootload code 172 | risc_boot.inc 173 | from Paul Reed at http://projectoberon.com/ 174 | 175 | Original Project Oberon 176 | design and source code copyright © 1991–2014 Niklaus Wirth (NW) and Jürg Gutknecht (JG) 177 | at http://www.inf.ethz.ch/personal/wirth/ProjectOberon/ 178 | or http://projectoberon.com/ 179 | 180 | Requirements: the freepacal compiler see: 181 | 182 | [Freepascal](https://github.com/graemeg/freepascal) 183 | or 184 | http://www.freepascal.org/ 185 | 186 | 09.jun.2016 187 | - Added the latest dsk file from Peter de Wachter 188 | - removed 2 calls in SDL2.pas because they are not compatible with libSDL2-2.0.0 189 | 190 | you may find this code at: 191 | 192 | https://github.com/MGreim/riscpas_repo 193 | 194 | ================================================================================ 195 | 196 | below the orignal README.md from Peter de Wachter 197 | 198 | ================================================================================ 199 | 200 | 201 | 202 | 203 | 204 | Oberon RISC Emulator 205 | ==================== 206 | 207 | This is an emulator for the Oberon RISC machine. For more information, see: 208 | http://www.inf.ethz.ch/personal/wirth/ and http://projectoberon.com/. 209 | 210 | Requirements: a C99 compiler (e.g. [GCC](http://gcc.gnu.org/), 211 | [clang](http://clang.llvm.org/)) and [SDL2](http://libsdl.org/). 212 | 213 | A suitable disk image can be downloaded from http://projectoberon.com/ (in 214 | S3RISCinstall.zip). **Warning**: Images downloaded before 2014-03-29 have 215 | broken floating point. 216 | 217 | Current emulation status 218 | ------------------------ 219 | 220 | * CPU 221 | * No known bugs. 222 | 223 | * Keyboard and mouse 224 | * OK. Note that Oberon assumes you have a US keyboard layout and 225 | a three button mouse. 226 | * The left alt key can now be used to emulate a middle click. 227 | 228 | * Display 229 | * OK. You can adjust the colors by editing `sdl-main.c`. 230 | * Use F11 to toggle full screen display. 231 | 232 | * SD-Card 233 | * Very inaccurate, but good enough for Oberon. If you're going to 234 | hack the SD card routines, you'll need to use real hardware. 235 | 236 | * RS-232 237 | * Implements PCLink protocol to send/receive single files at a time 238 | e.g. to receive Test.Mod into Oberon, run PCLink1.Start, 239 | then in host risc current directory, `echo Test.Mod > PCLink.REC` 240 | * Thanks to Paul Reed 241 | 242 | * Network 243 | * Not implemented. 244 | 245 | * LEDs 246 | * Printed on stdout. 247 | 248 | * Reset button 249 | * Press F12 to abort if you get stuck in an infinite loop. 250 | 251 | 252 | Copyright 253 | --------- 254 | 255 | Copyright © 2014 Peter De Wachter 256 | 257 | Permission to use, copy, modify, and/or distribute this software for 258 | any purpose with or without fee is hereby granted, provided that the 259 | above copyright notice and this permission notice appear in all 260 | copies. 261 | 262 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL 263 | WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED 264 | WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE 265 | AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL 266 | DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR 267 | PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 268 | TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 269 | PERFORMANCE OF THIS SOFTWARE. 270 | -------------------------------------------------------------------------------- /coredump.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MGreim/ultiboberon/1a2837aeb790271b721361d78fed1ad073547dbe/coredump.txt -------------------------------------------------------------------------------- /kernel7.img: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MGreim/ultiboberon/1a2837aeb790271b721361d78fed1ad073547dbe/kernel7.img -------------------------------------------------------------------------------- /risc-boot.inc: -------------------------------------------------------------------------------- 1 | $E7000151, $00000000, $00000000, $00000000, 2 | $00000000, $00000000, $00000000, $00000000, 3 | $4EE90014, $AFE00000, $A0E00004, $40000000, 4 | $A0E00008, $40000004, $A0E00010, $80E00010, 5 | $40090001, $A0E00010, $5000FFCC, $80000000, 6 | $40030001, $E8FFFFFC, $5000FFC8, $80000000, 7 | $A0E0000C, $80E00008, $81E0000C, $00080001, 8 | $40030008, $A0E00008, $80E00010, $E9FFFFEF, 9 | $80E00008, $81E00004, $A0100000, $8FE00000, 10 | $4EE80014, $C700000F, $4EE90010, $AFE00000, 11 | $40E80004, $F7FFFFDE, $80E00004, $40090000, 12 | $E6000012, $40E80008, $F7FFFFD9, $40E8000C, 13 | $F7FFFFD7, $80E00008, $81E0000C, $A1000000, 14 | $80E00008, $40080004, $A0E00008, $80E00004, 15 | $40090004, $A0E00004, $80E00004, $E9FFFFF3, 16 | $40E80004, $F7FFFFCA, $E7FFFFEB, $8FE00000, 17 | $4EE80010, $C700000F, $4EE90008, $AFE00000, 18 | $A0E00004, $5000FFD4, $41000000, $A1000000, 19 | $80E00004, $40090000, $E600000B, $80E00004, 20 | $40090001, $A0E00004, $5000FFD0, $5100FFFF, 21 | $A1000000, $5000FFD4, $80000000, $40030001, 22 | $E8FFFFFC, $E7FFFFF2, $8FE00000, $4EE80008, 23 | $C700000F, $4EE90008, $AFE00000, $A0E00004, 24 | $5000FFD4, $41000001, $A1000000, $5000FFD0, 25 | $81E00004, $A1000000, $5000FFD4, $80000000, 26 | $40030001, $E8FFFFFC, $8FE00000, $4EE80008, 27 | $C700000F, $4EE90018, $AFE00000, $A0E00004, 28 | $A1E00008, $40000001, $F7FFFFD3, $5000FFD0, 29 | $80000000, $A0E00010, $80E00010, $400900FF, 30 | $E9FFFFF8, $400000FF, $F7FFFFE2, $5000FFD0, 31 | $80000000, $A0E00010, $80E00010, $400900FF, 32 | $E9FFFFF8, $80E00004, $40090008, $E9000003, 33 | $40000087, $A0E00014, $E7000007, $80E00004, 34 | $E9000003, $40000095, $A0E00014, $E7000002, 35 | $400000FF, $A0E00014, $80E00004, $4004003F, 36 | $40080040, $F7FFFFCB, $40000018, $41090000, 37 | $E5000008, $A0E0000C, $80E00008, $81E0000C, 38 | $00030001, $F7FFFFC3, $80E0000C, $5008FFF8, 39 | $E7FFFFF6, $80E00014, $F7FFFFBE, $40000020, 40 | $A0E0000C, $400000FF, $F7FFFFBA, $5000FFD0, 41 | $80000000, $A0E00010, $80E0000C, $40090001, 42 | $A0E0000C, $80E00010, $40090080, $E5000002, 43 | $80E0000C, $E9FFFFF3, $8FE00000, $4EE80018, 44 | $C700000F, $4EE9000C, $AFE00000, $40000009, 45 | $F7FFFF91, $40000000, $41000000, $F7FFFFB5, 46 | $40000008, $410001AA, $F7FFFFB2, $5000FFFF, 47 | $F7FFFFA0, $5000FFFF, $F7FFFF9E, $5000FFFF, 48 | $F7FFFF9C, $40000037, $41000000, $F7FFFFA9, 49 | $40000029, $41000001, $4111001E, $F7FFFFA5, 50 | $5000FFD0, $80000000, $A0E00004, $5000FFFF, 51 | $F7FFFF90, $5000FFFF, $F7FFFF8E, $5000FFFF, 52 | $F7FFFF8C, $40002710, $F7FFFF73, $80E00004, 53 | $E9FFFFEC, $40000010, $41000200, $F7FFFF95, 54 | $40000001, $F7FFFF6C, $8FE00000, $4EE8000C, 55 | $C700000F, $4EE9000C, $AFE00000, $A0E00004, 56 | $4000003A, $41000000, $F7FFFF8A, $5000FFD0, 57 | $80000000, $A0E00008, $5000FFFF, $F7FFFF75, 58 | $80E00008, $E9000004, $5000FFD0, $80000000, 59 | $40030007, $E0000005, $80E00004, $80000000, 60 | $40010009, $81E00004, $A0100000, $5000FFFF, 61 | $F7FFFF68, $5000FFFF, $F7FFFF66, $40000001, 62 | $F7FFFF4D, $8FE00000, $4EE8000C, $C700000F, 63 | $4EE90014, $AFE00000, $A0E00004, $A1E00008, 64 | $40E80004, $F7FFFFDB, $40000011, $81E00004, 65 | $F7FFFF68, $40000000, $A0E0000C, $5000FFFF, 66 | $F7FFFF54, $5000FFD0, $80000000, $A0E00010, 67 | $80E0000C, $40080001, $A0E0000C, $80E00010, 68 | $400900FE, $E9FFFFF5, $5000FFD4, $41000005, 69 | $A1000000, $40000000, $410901FC, $EE000014, 70 | $A0E0000C, $5000FFD0, $5100FFFF, $A1000000, 71 | $5000FFD4, $80000000, $40030001, $E8FFFFFC, 72 | $5000FFD0, $80000000, $A0E00010, $80E00008, 73 | $81E00010, $A1000000, $80E00008, $40080004, 74 | $A0E00008, $80E0000C, $40080004, $E7FFFFEA, 75 | $400000FF, $F7FFFF2F, $400000FF, $F7FFFF2D, 76 | $40000001, $F7FFFF14, $8FE00000, $4EE80014, 77 | $C700000F, $4EE90014, $AFE00000, $60000008, 78 | $40060004, $A0E00004, $80E00004, $41000000, 79 | $F7FFFFBF, $40000010, $80000000, $A0E00010, 80 | $80E00004, $40080001, $A0E00004, $40000200, 81 | $A0E00008, $80E00008, $81E00010, $00090001, 82 | $ED00000A, $80E00004, $81E00008, $F7FFFFB0, 83 | $80E00004, $40080001, $A0E00004, $80E00008, 84 | $40080200, $A0E00008, $E7FFFFF2, $8FE00000, 85 | $4EE80014, $C700000F, $4D000000, $5E00FFC0, 86 | $6E000008, $4C000020, $0000000F, $40090000, 87 | $E9000012, $40000080, $5100FFC4, $A0100000, 88 | $F7FFFF50, $5000FFC4, $80000000, $40030001, 89 | $E8000005, $40000081, $5100FFC4, $A0100000, 90 | $F7FFFEC1, $E7000004, $40000082, $5100FFC4, 91 | $A0100000, $F7FFFFC7, $E7000008, $5000FFC4, 92 | $80000000, $40030001, $E8000004, $40000081, 93 | $5100FFC4, $A0100000, $F7FFFEB3, $4000000C, 94 | $6100000E, $41167EF0, $A1000000, $40000018, 95 | $61000008, $A1000000, $40000084, $5100FFC4, 96 | $A0100000, $40000000, $C7000000, $00000000, 97 | $00000000, $00000000, $00000000, $00000000 -------------------------------------------------------------------------------- /risccore.pas: -------------------------------------------------------------------------------- 1 | {*********************************} 2 | { The core of the RISC 5 machine } 3 | {*********************************} 4 | 5 | UNIT risccore; 6 | 7 | INTERFACE 8 | 9 | USES 10 | platform, (* for the LED *) 11 | riscsd, riscfp, riscglob; 12 | 13 | CONST 14 | maxregister = 16; 15 | MemSize = $100000; 16 | MemWords = (MemSize div 4); 17 | ROMWords = 512; 18 | maxkeybufsize = MAX_PS2_CODE_LEN; 19 | DISPLAYEND = $0FFF00; 20 | Displaystart = Displayend - RISC_SCREEN_WIDTH * RISC_SCREEN_HEIGHT DIV 8; 21 | 22 | TYPE 23 | 24 | regspace = 0..pred(maxregister); 25 | regty = ARRAY[0..pred(maxregister)] of uint32_t; 26 | 27 | keybufty = ARRAY [0..Pred(maxkeybufsize)] of uint8_t; 28 | 29 | 30 | RISCty = OBJECT 31 | PRIVATE 32 | PC: uint32_t; 33 | R: ARRAY [0..Pred(maxregister)] of uint32_t; 34 | H: uint32_t; 35 | Z: bool; 36 | N: bool; 37 | C: bool; 38 | V: bool; 39 | progress: uint32_t; 40 | current_tick: uint32_t; 41 | mouse: uint32_t; 42 | key_buf: keybufty; 43 | key_cnt: uint32_t; 44 | leds: uint32_t; 45 | spi_selected: uint32_t; 46 | sd_card: Boolean; 47 | ROM: ARRAY [0..Pred(ROMWords)] of uint32_t; 48 | (* Fore Debugging *) 49 | cyclecounter : qword; 50 | DUMP : TEXT; 51 | lastop : uint32_t; 52 | lastinstruction : uint32_t; 53 | lasttyp : uint32_t; 54 | lastpc : uint32_t; 55 | lasta_val, lastb_val, lastc_val, lastaddress : uint32_t; 56 | coredumpfromcycle, coredumptocycle : uint32_t; 57 | (* end only for debugging *) 58 | PUBLIC 59 | RAM: ARRAY [0..Pred(MemWords)] of uint32_t; 60 | PRIVATE 61 | PROCEDURE single_step; 62 | PROCEDURE set_register(reg: integer; value: uint32_t); 63 | FUNCTION load_word(address: uint32_t): uint32_t; 64 | FUNCTION load_byte(address: uint32_t): uint8_t; 65 | PROCEDURE store_word(address: uint32_t; value: uint32_t); 66 | PROCEDURE store_byte(address: uint32_t; value: uint8_t); 67 | FUNCTION load_io(address: uint32_t): uint32_t; 68 | PROCEDURE store_io(address: uint32_t; value: uint32_t); 69 | PROCEDURE coredump; 70 | PROCEDURE coredumpinit(froms, tos : string); 71 | PROCEDURE coredumpclose; 72 | PUBLIC 73 | CONSTRUCTOR init(filename : string; froms, tos : string); 74 | PROCEDURE run(cycles : uint32_t); 75 | PROCEDURE set_time(tick: uint32_t); 76 | PROCEDURE mouse_moved(mouse_x: integer; mouse_y: integer); 77 | PROCEDURE mouse_button(button: integer; down: bool); 78 | PROCEDURE keyboard_input(scancodes: keybufty; len: uint32_t); 79 | FUNCTION get_framebuffer_ptr: uint32_t; 80 | 81 | 82 | PROCEDURE reset; 83 | DESTRUCTOR done; 84 | END; 85 | 86 | 87 | 88 | VAR risc : riscty; 89 | 90 | 91 | implementation 92 | 93 | CONST 94 | IOStart = $0FFFC0; (* = 1048521 *) 95 | ROMStart = $0FE000; 96 | ROMbootsize = 388; 97 | 98 | (* bootloader: ARRAY [0..Pred(ROMWords)] of uint32_t = ( *) 99 | (* 388 otherwise i have to fill up the risc files, or i have to read it dynamically *) 100 | bootloader: ARRAY[0..Pred(ROMbootsize)] of uint32_t = ({$include "./risc-boot.inc"}); 101 | 102 | 103 | 104 | TYPE 105 | enumtype = ( 106 | MOV_ = 0, 107 | LSL_ = 1, 108 | ASR_ = 2, 109 | ROR_ = 3, 110 | AND_ = 4, 111 | ANN_ = 5, 112 | IOR_ = 6, 113 | XOR_ = 7, 114 | ADD_ = 8, 115 | SUB_ = 9, 116 | MUL_ = 10, 117 | DIV_ = 11, 118 | FAD_ = 12, 119 | FSB_ = 13, 120 | FML_ = 14, 121 | FDV_ = 15 122 | ); 123 | 124 | (* 125 | VAR 126 | 127 | riscoperator : ARRAY[0..15] OF string = ( 128 | 'MOV', 129 | 'LSL', 130 | 'ASR', 131 | 'ROR', 132 | 'AND', 133 | 'ANN', 134 | 'IOR', 135 | 'XOR', 136 | 'ADD', 137 | 'SUB', 138 | 'MUL', 139 | 'DIV', 140 | 'FAD', 141 | 'FSB', 142 | 'FML', 143 | 'FDV' 144 | ); 145 | 146 | *) 147 | 148 | CONSTRUCTOR riscty.init(filename : string; froms, tos : string); 149 | 150 | var lauf : integer; 151 | BEGIN 152 | for lauf := 0 to pred(ROMbootsize) do 153 | 154 | BEGIN 155 | rom[lauf] := bootloader[lauf]; 156 | END; 157 | 158 | PC:= ROMStart div 4; 159 | coredumpinit(froms, tos); 160 | disk.init(filename); 161 | cyclecounter := 1; 162 | fp.init; 163 | sd_card := Disk.sdcard; 164 | (* writeln('Riscty init PC : ', PC); 165 | writeln('SD Card ', sd_card); *) 166 | 167 | END; 168 | 169 | DESTRUCTOR riscty.done; 170 | BEGIN 171 | END; 172 | 173 | 174 | PROCEDURE riscty.coredumpinit(froms, tos : string); 175 | 176 | 177 | FUNCTION validnumber(s : string) : uint32_t; 178 | 179 | VAR code : word; 180 | v : double; 181 | 182 | BEGIN 183 | validnumber := 0; 184 | val(s, v, code); 185 | IF code <> 0 THEN v := 0; 186 | validnumber := abs(round(v)); 187 | END; 188 | 189 | 190 | BEGIN 191 | IF froms = '' THEN exit; 192 | IF tos = '' THEN exit; 193 | coredumpfromcycle := 0; 194 | coredumptocycle := 0; 195 | 196 | {$I-} 197 | assign(DUMP, 'coredump.txt'); 198 | rewrite(DUMP); 199 | append(DUMP); 200 | {$I+} 201 | IF ioresult <> 0 THEN 202 | 203 | BEGIN 204 | exit; 205 | END 206 | ELSE 207 | BEGIN 208 | coredumpfromcycle := validnumber(froms); 209 | coredumptocycle := validnumber(tos); 210 | END; 211 | IF coredumptocycle < coredumpfromcycle THEN coredumptocycle := coredumptocycle; 212 | lasta_val := 0; 213 | lastb_val := 0; 214 | lastc_val := 0; 215 | END; 216 | 217 | 218 | PROCEDURE riscty.coredumpclose; 219 | 220 | BEGIN 221 | close(DUMP); 222 | writeln('Dumpfile, closed'); 223 | END; 224 | 225 | 226 | PROCEDURE riscty.coredump; 227 | 228 | 229 | VAR lauf : integer; 230 | 231 | FUNCTION bc(b : Boolean) : string; 232 | BEGIN 233 | IF b THEN bc := '1' ELSE bc := '0'; 234 | END; 235 | 236 | BEGIN 237 | write(DUMP, 'Cycle ',cyclecounter,#9,'PC ', lastpc,#9, 'OP ',lastop,#9, 'Type ', lasttyp,#9, 'Instruction ',lastinstruction,#9,'Address ',lastaddress,#9); 238 | write(DUMP, 'Z ', bc(Z),#9); 239 | write(DUMP, ' N ', bc(N),#9); 240 | write(DUMP, ' C ', bc(C),#9); 241 | write(DUMP, ' V ', bc(V),#9); 242 | 243 | 244 | 245 | write(DUMP, ' A ', (lasta_val),#9); 246 | write(DUMP, ' B ', (lastb_val), #9); 247 | write(DUMP, ' C ', (lastc_val), #9); 248 | write(DUMP, 'R '); 249 | FOR lauf := 0 TO 15 DO 250 | 251 | BEGIN 252 | write(DUMP, longint(R[lauf]),#9); 253 | END; 254 | 255 | writeln(DUMP); 256 | END; 257 | 258 | PROCEDURE riscty.run(cycles : uint32_t); 259 | 260 | VAR i : uint32_t; 261 | BEGIN 262 | progress := 20; (* The progress value is used to detect that the RISC cpu is busy*) 263 | (* waiting on the millisecond counter or on the keyboard ready*) 264 | (* bit. In that case it's better to just pause emulation until the*) 265 | (* next frame.*) 266 | i := 0; 267 | WHILE (progress > 0) AND (i < cycles) DO 268 | 269 | BEGIN 270 | single_step; 271 | inc(i); 272 | inc(cyclecounter); 273 | END; 274 | (* writeln(' i ', i, ' progress ', progress); *) 275 | END; 276 | 277 | PROCEDURE riscty.single_step; 278 | const 279 | pbit: uint32_t = $80000000; 280 | qbit: uint32_t = $40000000; 281 | ubit: uint32_t = $20000000; 282 | vbit: uint32_t = $10000000; 283 | var 284 | ir: uint32_t; 285 | a: uint32_t; 286 | b: uint32_t; 287 | op: uint32_t; 288 | im: uint32_t; 289 | c_ : uint32_t; 290 | a_val: uint32_t; 291 | b_val: uint32_t; 292 | c_val: uint32_t; 293 | tmp: uint64_t; 294 | off: uint32_t; 295 | address: uint32_t; 296 | t, cx: Boolean; 297 | 298 | 299 | BEGIN 300 | 301 | IF PC < (ROMStart div 4) THEN ir := RAM[PC] ELSE ir:= ROM[PC - (ROMStart div 4)]; 302 | lastinstruction := ir; 303 | 304 | inc(PC); 305 | lastpc := PC; 306 | lasta_val := 0; 307 | lastb_val := 0; 308 | lastc_val := 0; 309 | lastaddress := 0; 310 | a_val := 0; 311 | b_val := 0; 312 | c_val := 0; 313 | address := 0; 314 | off := 0; 315 | 316 | IF (ir and pbit) = 0 THEN 317 | BEGIN 318 | (* Register instructions*) 319 | a := (ir and $0F000000) shr 24; 320 | b := (ir and $00F00000) shr 20; 321 | op := (ir and $000F0000) shr 16; 322 | im := (ir and $0000FFFF); 323 | c_ := (ir and $0000000F); 324 | 325 | b_val := R[b]; 326 | IF (ir and qbit) = 0 THEN c_val:= R[c_] ELSE 327 | 328 | BEGIN 329 | IF (ir and vbit) = 0 THEN c_val := im ELSE c_val := ($FFFF0000 or im); 330 | END; 331 | lastop := op; 332 | lasttyp := 1; 333 | 334 | CASE op of 335 | 336 | ord(MOV_) : BEGIN 337 | IF (ir and ubit) = 0 THEN a_val := c_val ELSE 338 | BEGIN 339 | IF (ir and qbit) <>0 THEN a_val := (c_val shl 16) 340 | ELSE 341 | BEGIN 342 | IF (ir and vbit) <> 0 THEN a_val := $D0 or (b2i(N) * $80000000) or (b2i(Z) * $40000000) or (b2i(C) * $20000000) or (b2i(V) * $10000000) 343 | ELSE a_val := H; 344 | END;(* ELSE*) 345 | END; 346 | END; (*case sequence *) 347 | 348 | ord(LSL_) : BEGIN 349 | a_val := b_val shl (c_val and 31); 350 | END; 351 | 352 | ord(ASR_) : BEGIN 353 | a_val := (longword(b_val)) shr (c_val and 31); 354 | END; 355 | 356 | ord(ROR_) : BEGIN 357 | a_val := (b_val shr (c_val and 31)) or (b_val shl (-c_val and 31)); 358 | END; 359 | 360 | ord(AND_): BEGIN 361 | a_val := b_val and c_val; 362 | END; 363 | 364 | ord(ANN_): BEGIN 365 | a_val:= b_val and not(c_val); 366 | END; 367 | 368 | ord(IOR_): BEGIN 369 | a_val:= b_val or c_val; 370 | END; 371 | 372 | ord(XOR_): BEGIN 373 | a_val:= b_val xor c_val; 374 | END; 375 | 376 | ord(ADD_): BEGIN 377 | {$R-} 378 | a_val := b_val + c_val; 379 | {$R+} 380 | IF (((ir and ubit) <> 0) and risc.C) THEN a_val := a_val + 1; 381 | risc.C:= a_val < b_val; 382 | 383 | risc.V:= ((not(b_val xor c_val) and (a_val xor b_val)) shr 31) <> 0; 384 | END; 385 | 386 | ord(SUB_): BEGIN 387 | cx := c_val > b_val; 388 | 389 | {$R-} 390 | a_val := b_val - c_val; 391 | {$R+} 392 | 393 | IF (((ir and ubit) <> 0) and C) THEN a_val := a_val - 1; 394 | risc.C := cx; 395 | risc.V := (((b_val xor c_val) and (a_val xor b_val)) shr 31) <> 0; 396 | END; 397 | 398 | ord(MUL_): BEGIN 399 | IF (ir and ubit) = 0 THEN 400 | BEGIN 401 | tmp:= qword(integer(b_val)) * qword(integer(c_val)); 402 | END 403 | ELSE 404 | BEGIN 405 | tmp:= qword(b_val) * qword(c_val); 406 | END; 407 | a_val:= tmp; 408 | H:= tmp shr 32; 409 | END; 410 | 411 | ord(DIV_): BEGIN 412 | (* what to do with a negative divisor?*) 413 | IF c_val <= 0 THEN 414 | 415 | BEGIN 416 | // writeln(' ERROR: PC ', (PC * 4 - 4) , ': divisor ',c_val, ' is not positive'); 417 | a_val := $DEADBEEF; 418 | H := $DEADBEEF; 419 | 420 | END 421 | ELSE 422 | BEGIN 423 | a_val := longint(b_val) div longint(c_val); 424 | H:= longint(b_val) mod longint(c_val); 425 | IF longint(H) < 0 THEN 426 | BEGIN 427 | dec(a_val); 428 | H := H + (c_val); 429 | END; 430 | END; 431 | END; 432 | 433 | 434 | ord(FAD_): BEGIN 435 | 436 | a_val := fp.add_(b_val, c_val, i2b(ir AND ubit), i2b(ir AND vbit) ); 437 | END; 438 | 439 | ord(FSB_): BEGIN 440 | a_val := fp.add_(b_val, (c_val XOR $80000000), i2b(ir AND ubit), i2b(ir AND vbit)); 441 | END; 442 | 443 | ord(FML_): BEGIN 444 | a_val := fp.mul_(b_val, c_val); 445 | END; 446 | 447 | ord(FDV_): BEGIN 448 | a_val := fp.div_(b_val, c_val); 449 | END; 450 | END;{case} 451 | 452 | set_register(a, a_val); 453 | END (* IF*) 454 | ELSE 455 | IF (ir and qbit) = 0 THEN 456 | BEGIN 457 | lasttyp := 2; 458 | (* Memory instructions*) 459 | a := (ir and $0F000000) shr 24; 460 | b := (ir and $00F00000) shr 20; 461 | off := ir and $000FFFFF; 462 | address := (R[b] + off) mod MemSize; 463 | lastaddress := address; 464 | 465 | IF (ir and ubit) = 0 THEN 466 | BEGIN 467 | IF (ir and vbit) = 0 THEN a_val:= load_word(address) 468 | ELSE a_val:= load_byte(address); 469 | set_register(a, a_val); 470 | 471 | END 472 | ELSE 473 | BEGIN 474 | IF (ir and vbit) = 0 THEN store_word(address, R[a]) 475 | ELSE store_byte(address, byte(R[a])); 476 | END; 477 | END 478 | ELSE 479 | BEGIN 480 | (* Branch instructions*) 481 | lasttyp := 3; 482 | CASE ((ir shr 24) and 15) OF 483 | 0: t := N; 484 | 1: t := Z; 485 | 2: t:= C; 486 | 3: t:= V; 487 | 4: t:= C or Z; 488 | 5: t:= N <> V; 489 | 6: t:= (N <> V) or Z; 490 | 7: t:= true; 491 | 8: t:= not(N); 492 | 9: t:= not(Z); 493 | 10: t:= not(C); 494 | 11: t:= not(V); 495 | 12: t:= not(C or Z); 496 | 13: t:= not(N <> V); 497 | 14: t:= not((N <> V) or Z); 498 | 15: t:= false; 499 | END; (*case*) 500 | 501 | IF t THEN 502 | BEGIN 503 | IF ((ir and vbit)<>0) THEN 504 | 505 | BEGIN 506 | set_register(15, PC*4); 507 | END; 508 | 509 | IF (ir and ubit) = 0 THEN 510 | BEGIN 511 | c_ := ir and $0000000F; 512 | PC:= (R[c_] div 4) mod MemWords; 513 | END 514 | ELSE 515 | BEGIN 516 | off:= ir and $00FFFFFF; 517 | PC:= (PC + off) mod MemWords; 518 | END; 519 | END;(* t *) 520 | END; (* IF Branch *) 521 | 522 | lasta_val := a_val; 523 | lastb_val := b_val; 524 | lastc_val := c_val; 525 | IF (cyclecounter >= coredumpfromcycle) AND (cyclecounter < coredumptocycle) THEN coredump; 526 | IF cyclecounter = coredumptocycle THEN coredumpclose; 527 | END; (* proc *) 528 | 529 | PROCEDURE riscty.set_register(reg: integer; value: uint32_t); 530 | 531 | VAR temp : longint; 532 | 533 | BEGIN 534 | R[reg]:= value; 535 | Z := (value = 0); 536 | 537 | (* N := (value < 0); this will never happen ?? *) 538 | {$R-} 539 | temp := longint(value); 540 | {$R+} 541 | N := (temp < 0); 542 | END; 543 | 544 | FUNCTION riscty.load_word(address: uint32_t): uint32_t; 545 | 546 | BEGIN 547 | IF address < IOStart THEN 548 | BEGIN 549 | load_word := RAM[address div 4]; 550 | END 551 | ELSE 552 | BEGIN 553 | load_word := load_io(address); 554 | END; 555 | END; 556 | 557 | FUNCTION riscty.load_byte(address: uint32_t): uint8_t; 558 | 559 | var 560 | w: uint32_t; 561 | 562 | BEGIN 563 | w := load_word(address); 564 | load_byte := byte(w shr ((address MOD 4)*8)); 565 | END; 566 | 567 | PROCEDURE riscty.store_word(address: uint32_t; value: uint32_t); 568 | BEGIN 569 | IF address < IOStart THEN RAM[address div 4] := value 570 | ELSE 571 | store_io(address, value); 572 | END; 573 | 574 | PROCEDURE riscty.store_byte(address: uint32_t; value: uint8_t); 575 | 576 | VAR 577 | w: uint32_t; 578 | shift: uint32_t; 579 | 580 | BEGIN 581 | 582 | 583 | 584 | IF address < IOStart THEN 585 | BEGIN 586 | w := RAM[address DIV 4]; 587 | shift := (address and 3)*8; 588 | w := w and ( not($00FF shl shift)); 589 | w := w or (longword(value) shl shift); 590 | RAM[address DIV 4] := w; 591 | END 592 | ELSE 593 | BEGIN 594 | store_io(address, longword(value)); 595 | END; 596 | END; 597 | 598 | FUNCTION riscty.load_io(address: uint32_t): uint32_t; 599 | var 600 | tmouse: uint32_t; 601 | scancodebyte : uint8_t; 602 | 603 | BEGIN 604 | CASE address-IOStart OF 605 | 606 | 0: BEGIN 607 | (* Millisecond counter*) 608 | dec(progress); 609 | load_io := current_tick; 610 | END; 611 | 612 | 4: BEGIN 613 | (* Switches*) 614 | load_io := 0; 615 | END; 616 | 617 | 8: BEGIN 618 | (* load_io := pclink.rdata; *) 619 | END; 620 | 621 | 12: BEGIN 622 | (* load_io := pclink.rstat; *) 623 | END; 624 | 625 | 16: BEGIN 626 | (* SPI data*) 627 | IF ((spi_selected = 1) and sd_card) THEN 628 | 629 | BEGIN 630 | load_io := disk.read_; 631 | END 632 | ELSE 633 | BEGIN 634 | load_io := 255; 635 | END; 636 | END; 637 | 638 | 20: BEGIN 639 | (* SPI status*) 640 | (* Bit 0: rx ready*) 641 | (* Other bits unused*) 642 | load_io := 1; 643 | END; 644 | 645 | 24: BEGIN 646 | (* Mouse input / keyboard status*) 647 | tmouse := mouse; 648 | IF key_cnt > 0 THEN tmouse:= (tmouse or ($10000000)) ELSE dec(progress); 649 | load_io := tmouse; 650 | END; 651 | 652 | 28: BEGIN 653 | (* Keyboard input*) 654 | IF key_cnt > 0 THEN 655 | BEGIN 656 | scancodebyte := key_buf[0]; 657 | dec(key_cnt); 658 | move(key_buf[1], key_buf[0], key_cnt); 659 | load_io := scancodebyte; 660 | END; 661 | END; 662 | 663 | ELSE load_io := 0; 664 | END; (* case *) 665 | END; 666 | 667 | PROCEDURE riscty.store_io(address: uint32_t; value: uint32_t); 668 | 669 | VAR i : 0..7; 670 | 671 | BEGIN 672 | CASE address - IOStart of 673 | 4: BEGIN 674 | (* LED control*) 675 | leds:= value; 676 | //write('LEDs: '); 677 | FOR i := 7 DOWNTO 0 DO 678 | BEGIN 679 | IF ((leds and (1 shl i)) > 0) THEN ActivityLEDOn ELSE ActivityLEDoff; 680 | END; 681 | //writeln; 682 | END; 683 | 684 | 8: BEGIN 685 | (* pclink.Tdata(value); *) 686 | END; 687 | 688 | 16:BEGIN 689 | (* SPI write*) 690 | IF ((spi_selected = 1) and sd_card) THEN disk.write_(value); 691 | END; 692 | 20: BEGIN 693 | (* SPI control*) 694 | (* Bit 0-1: slave select*) 695 | (* Bit 2: fast mode*) 696 | (* Bit 3: netwerk enable*) 697 | (* Other bits unused*) 698 | spi_selected := value and 3; 699 | END; 700 | END;{case} 701 | END; 702 | 703 | PROCEDURE riscty.set_time(tick: uint32_t); 704 | BEGIN 705 | current_tick:= tick; 706 | END; 707 | 708 | PROCEDURE riscty.mouse_moved(mouse_x: integer; mouse_y: integer); 709 | BEGIN 710 | IF (mouse_x >= 0) and (mouse_x < 1024) THEN mouse:= (mouse and not($00000FFF)) or mouse_x; 711 | IF (mouse_y >= 0) and (mouse_y < 1024) THEN mouse:= (mouse and not($00FFF000)) or (mouse_y shl 12); 712 | END; 713 | 714 | PROCEDURE riscty.mouse_button(button: integer; down: bool); 715 | var bit: longint; 716 | 717 | BEGIN 718 | IF ((button >= 1) and (button < 4)) THEN 719 | BEGIN 720 | bit := 1 shl (27-button); 721 | IF down THEN mouse:= mouse or bit 722 | ELSE mouse:= mouse and (not(bit)); 723 | END; 724 | END; 725 | 726 | PROCEDURE riscty.keyboard_input(scancodes: keybufty; len: uint32_t); 727 | 728 | BEGIN 729 | IF sizeof(key_buf) - key_cnt >= len THEN 730 | BEGIN 731 | move(scancodes, key_buf[key_cnt], len); 732 | key_cnt:= key_cnt + len; 733 | END; 734 | END; 735 | 736 | FUNCTION riscty.get_framebuffer_ptr: uint32_t; 737 | 738 | BEGIN 739 | get_framebuffer_ptr := DisplayStart div 4; 740 | END; 741 | 742 | PROCEDURE riscty.reset; 743 | 744 | BEGIN 745 | PC := ROMSTART DIV 4; 746 | END; 747 | 748 | 749 | 750 | 751 | 752 | 753 | 754 | END. 755 | 756 | -------------------------------------------------------------------------------- /riscfp.pas: -------------------------------------------------------------------------------- 1 | UNIT riscfp; 2 | 3 | 4 | INTERFACE 5 | 6 | uses riscglob; 7 | 8 | 9 | TYPE 10 | 11 | fpty = OBJECT 12 | public 13 | FUNCTION add_(x, y : uint32_t; u, v : Boolean) : uint32_t; 14 | FUNCTION mul_(x, y : uint32_t) : uint32_t; 15 | FUNCTION div_(x, y : uint32_t) : uint32_t; 16 | CONSTRUCTOR init; 17 | DESTRUCTOR done; 18 | END; 19 | 20 | 21 | 22 | 23 | VAR fp : fpty; 24 | 25 | FUNCTION b2i(b : Boolean) : uint8_t; 26 | FUNCTION i2b(i : uint32_t) : Boolean; 27 | 28 | 29 | IMPLEMENTATION 30 | 31 | FUNCTION b2i(b : Boolean) : uint8_t; 32 | 33 | BEGIN 34 | IF b THEN b2i := 1 ELSE b2i := 0; 35 | END; 36 | 37 | FUNCTION i2b(i : uint32_t) : Boolean; 38 | 39 | BEGIN 40 | IF i <> 0 THEN i2b := True ELSE i2b := False; 41 | END; 42 | 43 | 44 | 45 | CONSTRUCTOR fpty.init; 46 | 47 | BEGIN 48 | END; 49 | 50 | 51 | FUNCTION fpty.add_(x, y : uint32_t; u, v : Boolean) : uint32_t; 52 | 53 | 54 | VAR ys, xs : Boolean; 55 | xm, xe, ye, ym, e0, sum, s, e1, t3, shift : uint32_t; 56 | y0, x0, x3, y3 : int32; 57 | 58 | 59 | 60 | BEGIN 61 | xs := (x AND $80000000) <> 0; 62 | IF NOT(u) THEN 63 | BEGIN 64 | xe := (x SHR 23) AND $FF; 65 | xm := ((x AND $7FFFFF) SHL 1) OR $1000000; 66 | IF xs THEN x0 := -xm ELSE x0 := xm; 67 | END 68 | ELSE 69 | BEGIN 70 | xe := 150; 71 | x0 := (((x AND $00FFFFFF) SHL 8) SHR 7); 72 | END; 73 | 74 | ys := (y AND $80000000) <> 0; 75 | ye := (y SHR 23) AND $FF; 76 | ym := ((y AND $7FFFFF) SHL 1); 77 | 78 | IF (NOT(u) AND NOT(v)) THEN ym := ym OR $1000000; 79 | IF ys THEN y0 := -ym ELSE y0 := ym; 80 | 81 | IF (ye > xe) THEN 82 | BEGIN 83 | shift := ye - xe; 84 | e0 := ye; 85 | IF (shift > 31) THEN x3 := (x0 SHR 31) ELSE x3 := (x0 SHR shift); 86 | y3 := y0; 87 | END 88 | ELSE 89 | BEGIN 90 | shift := xe - ye; 91 | e0 := xe; 92 | x3 := x0; 93 | IF (shift > 31) THEN y3 := (y0 SHR 31) ELSE y3 := (y0 SHR shift); 94 | END; 95 | 96 | 97 | sum := ((b2i(xs) SHL 26) OR (b2i(xs) SHL 25) OR (x3 AND $01FFFFFF)) 98 | + ((b2i(ys) SHL 26) OR (b2i(ys) SHL 25) OR (y3 AND $01FFFFFF)); 99 | 100 | IF ((sum AND (1 SHL 26)) <> 0) THEN s := -sum ELSE s:= sum; 101 | s := (s + 1) AND $07FFFFFF; 102 | 103 | e1 := e0 + 1; 104 | t3 := s SHR 1; 105 | IF ((s AND $3FFFFFC) <> 0) THEN 106 | 107 | BEGIN 108 | WHILE ((t3 AND (1 SHL 24)) = 0) DO 109 | BEGIN 110 | t3 := t3 SHL 1; 111 | dec(e1); 112 | END 113 | END 114 | ELSE 115 | BEGIN 116 | t3 := t3 SHL 24; 117 | e1 := e1 - 24; 118 | END; 119 | 120 | IF v THEN 121 | 122 | BEGIN 123 | add_ := (sum SHL 5) SHR 6; 124 | exit; 125 | END 126 | ELSE 127 | BEGIN 128 | IF ((x AND $7FFFFFFF) = 0) THEN 129 | BEGIN 130 | IF NOT(u) THEN add_ := y ELSE add_ := 0; 131 | exit 132 | END; 133 | 134 | IF ((y AND $7FFFFFFF) = 0) THEN 135 | 136 | BEGIN 137 | add_ := x; 138 | exit; 139 | END; 140 | IF ((t3 AND $01FFFFFF) = 0) OR ((e1 AND $100) <> 0) THEN 141 | 142 | BEGIN 143 | add_ := 0; 144 | exit; 145 | END; 146 | END; 147 | 148 | add_ := ((sum AND $04000000) SHL 5) OR (e1 SHL 23) OR ((t3 SHR 1) AND $7FFFFF); 149 | 150 | END; 151 | 152 | 153 | FUNCTION fpty.mul_( x,y : uint32_t) : uint32_t; 154 | 155 | VAR 156 | sign, xe, ye, xm, ym, e1, z0 : uint32_t; 157 | m : uint64_t; 158 | 159 | 160 | BEGIN 161 | sign := (x XOR y) AND $80000000; 162 | xe := (x SHR 23) AND $FF; 163 | ye := (y SHR 23) AND $FF; 164 | 165 | xm := (x AND $7FFFFF) OR $800000; 166 | ym := (y AND $7FFFFF) OR $800000; 167 | m := xm * ym; 168 | 169 | e1 := (xe + ye) - 127; 170 | IF ((m AND (1 SHL 47)) <> 0) THEN 171 | 172 | BEGIN 173 | inc(e1); 174 | z0 := (m SHR 24) AND $7FFFFF; 175 | END 176 | ELSE 177 | BEGIN 178 | z0 := (m SHR 23) AND $7FFFFF; 179 | END; 180 | 181 | 182 | IF ((xe = 0) OR (ye = 0)) THEN 183 | BEGIN 184 | mul_ := 0; 185 | exit; 186 | END; 187 | IF ((e1 AND $100) = 0) THEN 188 | 189 | BEGIN 190 | mul_ := sign OR ((e1 AND $FF) SHL 23) OR z0; 191 | exit; 192 | END; 193 | IF ((e1 AND $80) = 0) THEN 194 | 195 | BEGIN 196 | mul_ := sign OR ($FF SHL 23) OR z0; 197 | exit; 198 | END; 199 | 200 | mul_ := 0; 201 | END; 202 | 203 | 204 | FUNCTION fpty.div_( x,y : uint32_t ) : uint32_t; 205 | 206 | VAR 207 | e1, sign, xe, ye, xm, ym, q1, q2 : uint32_t; 208 | 209 | 210 | BEGIN 211 | sign := (x XOR y) AND $80000000; 212 | xe := (x SHR 23) AND $FF; 213 | ye := (y SHR 23) AND $FF; 214 | 215 | xm := (x AND $7FFFFF) OR $800000; 216 | ym := (y AND $7FFFFF) OR $800000; 217 | q1 := (xm * (1 SHL 23) DIV ym); 218 | 219 | e1 := (xe - ye) + 126; 220 | 221 | 222 | IF ((q1 AND $800000) <> 0) THEN 223 | 224 | BEGIN 225 | inc(e1); 226 | q2 := q1 AND $7FFFFF; 227 | END 228 | ELSE 229 | BEGIN 230 | q2 := (q1 SHL 1) AND $7FFFFF; 231 | END; 232 | 233 | IF (xe = 0) THEN 234 | 235 | BEGIN 236 | div_ := 0; 237 | exit; 238 | END; 239 | 240 | IF (ye = 0) THEN 241 | 242 | BEGIN 243 | div_ := sign OR ($FF SHL 23); 244 | exit; 245 | END; 246 | IF ((e1 AND $100) = 0) THEN 247 | 248 | BEGIN 249 | div_ := sign OR ((e1 AND $FF) SHL 23) OR q2; 250 | exit; 251 | END; 252 | 253 | IF ((e1 AND $80) = 0) THEN 254 | 255 | BEGIN 256 | div_ := sign OR ($FF SHL 23) OR q2; 257 | exit; 258 | END; 259 | 260 | div_ := 0; 261 | 262 | END; 263 | 264 | DESTRUCTOR fpty.done; 265 | 266 | BEGIN 267 | END; 268 | 269 | END. 270 | -------------------------------------------------------------------------------- /riscglob.pas: -------------------------------------------------------------------------------- 1 | UNIT riscglob; 2 | 3 | INTERFACE 4 | 5 | 6 | 7 | CONST 8 | RISC_SCREEN_WIDTH = 1024; 9 | RISC_SCREEN_HEIGHT = 768; 10 | CPU_HZ = 25000000; 11 | FPS = 60; 12 | MAX_PS2_CODE_LEN = 8; 13 | 14 | TYPE 15 | uint32_t = longword; 16 | uint8_t = byte; 17 | bool = Boolean; 18 | uint64_t = QWord; 19 | 20 | 21 | 22 | IMPLEMENTATION 23 | 24 | END. 25 | -------------------------------------------------------------------------------- /riscpas.pas: -------------------------------------------------------------------------------- 1 | (* 2 | Oberon RISC Emulator for Pascal 3 | ============================== 4 | 5 | translation of the Oberon Risc Emulator from 6 | Peter De Wachter to Freepascal by Markus Greim 7 | 8 | I was using: 9 | 10 | The origianl C sources from: 11 | https://github.com/pdewacht/oberon-risc-emu 12 | (C) Peter de Wachter (Copyright Notice belwow) 13 | 14 | For the first try i was unsing 15 | c2pas32 v0.9b 16 | (c) 2001 Oleg Bulychov 17 | Gladiators Software 18 | http://www.astonshell.com/ 19 | but this was net a real help.. 20 | 21 | 22 | SDL2 headers translation for Free Pascal 23 | https://bitbucket.org/p_daniel/sdl-2-for-free-pascal-compiler 24 | from P. Daniel 25 | 26 | SDL 27 | Simple DirectMedia Layer 28 | Copyright (C) 1997-2013 Sam Lantinga 29 | 30 | The Oberon bootload code 31 | risc_boot.inc 32 | http://projectoberon.com/ 33 | from Paul Reed 34 | 35 | Original Project Oberon Sources and Disk Image: 36 | http://www.inf.ethz.ch/personal/wirth/ProjectOberon/index.html 37 | design and source code copyright (C) 1991-2014 Niklaus Wirth (NW) and Joerg Gutknecht (JG) 38 | 39 | -----Peter de Wachter Copyright Notice----------------------------------------------------------------- 40 | 41 | Copyright 42 | --------- 43 | 44 | Copyright (C) 2014 Peter De Wachter 45 | 46 | Permission to use, copy, modify, and/or distribute this software for 47 | any purpose with or without fee is hereby granted, provided that the 48 | above copyright notice and this permission notice appear in all 49 | copies. 50 | 51 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL 52 | WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED 53 | WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE 54 | AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL 55 | DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR 56 | PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 57 | TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 58 | PERFORMANCE OF THIS SOFTWARE. 59 | 60 | 61 | ===============================================================================================*) 62 | (* Bugs and known issues by Markus Greim: 63 | - 06.may.2014 64 | - refreshing screen works 65 | - coredum.txt is created when program called by 66 | riscpas oeberon.fs 1 10000 67 | - the numbers are the stored cycles 68 | 69 | - 03.may.2014 70 | Its starting up so far 71 | - refreshing of the screen only when mouse is moved 72 | - i am writing a coredump.txt for the first 2999 risc cycles 73 | 74 | *) 75 | 76 | 77 | 78 | 79 | {*********************************} 80 | {*********************************} 81 | 82 | PROGRAM riscpas; 83 | 84 | USES SDL2, risccore, riscps2, riscglob; 85 | 86 | const 87 | BLACK = $657b83; 88 | WHITE = $fdf6e3; 89 | 90 | (*static uint32_t BLACK = 0x000000, WHITE = 0xFFFFFF;*) 91 | (*static uint32_t BLACK = 0x0000FF, WHITE = 0xFFFF00;*) 92 | (*static uint32_t BLACK = 0x000000, WHITE = 0x00FF00;*) 93 | 94 | TYPE 95 | cachety = ARRAY[0..Pred(RISC_SCREEN_WIDTH*RISC_SCREEN_HEIGHT DIV 32)] of uint32_t; 96 | bufferty = ARRAY[0..Pred(RISC_SCREEN_WIDTH*RISC_SCREEN_HEIGHT)] OF uint32_t; 97 | 98 | 99 | VAR 100 | cache: cachety; 101 | buffer: bufferty; 102 | 103 | 104 | PROCEDURE init_texture(texture: pSDL_Texture); 105 | VAR i : longint; 106 | 107 | BEGIN 108 | fillchar(cache,sizeof(cache), 0); 109 | 110 | FOR i := 0 TO Pred(RISC_SCREEN_WIDTH*RISC_SCREEN_HEIGHT) DO 111 | 112 | BEGIN 113 | buffer[i] := BLACK; 114 | END; 115 | 116 | SDL_UpdateTexture(texture,NIL,@buffer,RISC_SCREEN_WIDTH*4); 117 | END; 118 | 119 | PROCEDURE update_texture(framebufferpointer : uint32_t; texture: pSDL_Texture); 120 | 121 | VAR 122 | dirty_y1: integer; 123 | dirty_y2: integer; 124 | dirty_x1: integer; 125 | dirty_x2: integer; 126 | idx: integer; 127 | pixels: uint32_t; 128 | rect: TSDL_Rect; 129 | ptr: Pointer; 130 | 131 | line : 0..RISC_SCREEN_HEIGHT; 132 | col : 0..RISC_SCREEN_WIDTH; 133 | bufferindex : 0..RISC_SCREEN_WIDTH*RISC_SCREEN_HEIGHT; 134 | b : 0..pred(32); 135 | 136 | BEGIN (* TODO: move dirty rectangle tracking into emulator core?*) 137 | (* writeln('upd texture'); *) 138 | dirty_y1 := RISC_SCREEN_HEIGHT; 139 | dirty_y2 := 0; 140 | dirty_x1 := RISC_SCREEN_WIDTH div 32; 141 | dirty_x2 := 0; 142 | 143 | idx := 0; 144 | FOR line := RISC_SCREEN_HEIGHT-1 DOWNTO 0 DO 145 | 146 | BEGIN 147 | FOR col := 0 TO pred(RISC_SCREEN_WIDTH DIV 32) DO 148 | BEGIN 149 | pixels := risc.RAM[idx+framebufferpointer]; 150 | IF pixels <> cache[idx] THEN 151 | BEGIN 152 | cache[idx] := pixels; 153 | IF line < dirty_y1 THEN dirty_y1 := line; 154 | IF line > dirty_y2 THEN dirty_y2 := line; 155 | IF col < dirty_x1 THEN dirty_x1 := col; 156 | IF col > dirty_x2 THEN dirty_x2 := col; 157 | 158 | bufferindex := line*RISC_SCREEN_WIDTH + col * 32; 159 | 160 | FOR b := 0 TO Pred(32) DO 161 | 162 | BEGIN 163 | IF (pixels AND 1) > 0 THEN buffer[bufferindex] := WHITE ELSE buffer[bufferindex] := BLACK; 164 | inc(bufferindex); 165 | pixels := pixels SHR 1; 166 | END; 167 | END;(*IF*) 168 | inc(idx); 169 | END;(*for col *) 170 | END;(*for line *) 171 | IF dirty_y1 <= dirty_y2 THEN 172 | 173 | BEGIN 174 | rect.x := dirty_x1 * 32; 175 | rect.y := dirty_y1; 176 | rect.w := (dirty_x2 - dirty_x1 + 1) * 32; 177 | rect.h := (dirty_y2 - dirty_y1 + 1); 178 | 179 | ptr:= @buffer[dirty_y1 * RISC_SCREEN_WIDTH + dirty_x1 * 32]; 180 | SDL_UpdateTexture(texture, @rect, ptr, RISC_SCREEN_WIDTH * 4); 181 | 182 | END; 183 | END; 184 | 185 | 186 | FUNCTION clamp(x, min, max : integer) : integer; 187 | 188 | VAR z : integer; 189 | 190 | BEGIN 191 | z := round(x); 192 | clamp := z; 193 | IF z < min THEN clamp := min; 194 | IF z > max THEN clamp := max; 195 | END; 196 | 197 | FUNCTION ceil(x : double) : longint; 198 | 199 | BEGIN 200 | Ceil := Trunc(x); 201 | If Frac(x) > 0 THEN Ceil := Ceil+1; 202 | END; 203 | 204 | 205 | 206 | FUNCTION scale_display(window : PSDL_WINDOW; VAR rect : TSDL_RECT) : double; 207 | 208 | VAR 209 | win_w, win_h : plongint; 210 | w, h : longint; 211 | oberon_aspect, window_aspect : double; 212 | scale : double; 213 | 214 | BEGIN 215 | new(win_w); 216 | new(win_h); 217 | SDL_GETWindowSize(window, win_w, win_h); 218 | oberon_aspect := RISC_SCREEN_WIDTH / RISC_SCREEN_HEIGHT; 219 | window_aspect := 1; 220 | IF win_h^ <> 0 THEN window_aspect := win_w^ / win_h^; 221 | IF oberon_aspect > window_aspect THEN scale := win_w^ / RISC_SCREEN_WIDTH 222 | ELSE scale := win_h^ / RISC_SCREEN_HEIGHT; 223 | w := ceil(RISC_SCREEN_WIDTH * scale); 224 | h := ceil(RISC_SCREEN_HEIGHT * scale); 225 | rect.w := w; 226 | rect.h := h; 227 | rect.x := (win_w^ - w) DIV 2; 228 | rect.y := (win_h^ - h) DIV 2; 229 | 230 | scale_display := scale; 231 | 232 | dispose(win_w); 233 | dispose(win_h); 234 | END; 235 | 236 | 237 | FUNCTION b2i(b : boolean) : integer; 238 | 239 | BEGIN 240 | IF b THEN b2i := 1 ELSE b2i := 0; 241 | END; 242 | 243 | PROCEDURE main; 244 | 245 | var 246 | window: pSDL_Window; 247 | renderer: pSDL_Renderer; 248 | texture: pSDL_Texture; 249 | done: bool; 250 | event: PSDL_Event; 251 | frame_start: uint32_t; 252 | 253 | scancode: keybufty; 254 | scancode_s : string; 255 | len : 0..pred(maxkeybufsize); 256 | l : 0..pred(maxkeybufsize); 257 | 258 | frame_end: uint32_t; 259 | 260 | delay: longint; 261 | window_pos, window_flags, display_cnt, i, x, y, scaled_x, scaled_y : longint; 262 | fullscreen, mouse_is_offscreen, mouse_was_offscreen, down : Boolean; 263 | bounds, display_rect : PSDL_Rect; 264 | display_scale : double; 265 | k : TSDL_keysym; 266 | 267 | 268 | 269 | BEGIN 270 | fullscreen := false; 271 | mouse_was_offscreen := false; 272 | new(bounds); 273 | new(display_rect); 274 | 275 | IF paramcount <> 1 THEN 276 | BEGIN 277 | writeln('Argv : ', paramcount); 278 | writeln('Args : ', paramstr(0), ' ', paramstr(1),' ',paramstr(2),' ',paramstr(3)); 279 | writeln('Usage: riscpas disk-file-name [coredumpfile_from_cycle coredumpfile_to_cycle]'); 280 | writeln('Stop with Alt-F4'); 281 | exitcode := 1; 282 | exit; 283 | END; 284 | 285 | risc.init(paramstr(1), paramstr(2), paramstr(3)); 286 | 287 | 288 | IF SDL_Init(SDL_INIT_VIDEO) <> 0 THEN 289 | BEGIN 290 | writeln('Unable to initialize SDL: ',SDL_GetError); 291 | exitcode := 1; 292 | exit; 293 | END; 294 | 295 | (* atexit(SDL_QuitEV); *) 296 | SDL_EnableScreenSaver; 297 | SDL_ShowCursor(0); 298 | SDL_SetHint(SDL_HINT_RENDER_SCALE_QUALITY, 'best'); 299 | 300 | 301 | (* risc.init(paramstr(1)); *) 302 | window_pos := SDL_WINDOWPOS_UNDEFINED; 303 | window_flags := SDL_WINDOW_HIDDEN; 304 | IF fullscreen THEN 305 | 306 | BEGIN 307 | window_flags := window_flags OR SDL_WINDOW_FULLSCREEN_DESKTOP; 308 | display_cnt := SDL_GetNumVideoDisplays; 309 | FOR i := 0 TO pred(display_cnt) DO 310 | 311 | BEGIN 312 | SDL_GETDIsplayBounds(i, bounds); 313 | IF (bounds^.w >= RISC_SCREEN_WIDTH) AND (bounds^.h = RISC_SCREEN_HEIGHT) THEN 314 | 315 | BEGIN 316 | (* window_pos := SDL_WINDOWPOS_UNDEFINED_DISPLAY(i); 317 | IF (bounds.w = RISC_SCREEN_WIDTH) THEN writeln('break?'); *) 318 | END; 319 | END; 320 | END; 321 | 322 | window := SDL_CreateWindow('Project Oberon',window_pos, window_pos, RISC_SCREEN_WIDTH,RISC_SCREEN_HEIGHT, window_flags); 323 | IF window = NIL THEN 324 | 325 | BEGIN 326 | writeln('Could not create window: ',SDL_GetError); 327 | exitcode:= 1; 328 | exit; 329 | END; 330 | 331 | renderer := SDL_CreateRenderer(window,-1,0); 332 | 333 | IF renderer= NIL THEN 334 | 335 | BEGIN 336 | writeln('Could not create renderer: ',SDL_GetError); 337 | exitcode:= 1; 338 | exit; 339 | END; 340 | 341 | texture := SDL_CreateTexture(renderer,SDL_PIXELFORMAT_ARGB8888, 342 | SDL_TEXTUREACCESS_STREAMING, 343 | RISC_SCREEN_WIDTH,RISC_SCREEN_HEIGHT); 344 | 345 | IF texture = NIL THEN 346 | 347 | BEGIN 348 | writeln('Could not create texture: ',SDL_GetError); 349 | exitcode:= 1; 350 | exit; 351 | END; 352 | 353 | display_scale := scale_display(window, display_rect^); 354 | init_texture(texture); 355 | SDL_ShowWindow(window); 356 | SDL_RenderClear(renderer); 357 | SDL_RenderCopy(renderer,texture,NIL,display_rect); 358 | SDL_RenderPresent(renderer); 359 | 360 | done := False; 361 | mouse_was_offscreen := False; 362 | new(event); 363 | 364 | WHILE NOT(done) DO 365 | 366 | BEGIN 367 | frame_start:=SDL_GetTicks; 368 | WHILE (SDL_PollEvent(event) = 1) DO 369 | 370 | BEGIN 371 | 372 | CASE event^.type_ OF 373 | 374 | SDL_QUITEV: 375 | BEGIN 376 | done:= True; 377 | END; 378 | 379 | SDL_WINDOWEVENT: 380 | BEGIN 381 | IF event^.window.event = SDL_WINDOWEVENT_RESIZED THEN 382 | 383 | BEGIN 384 | display_scale := scale_display(window, display_rect^); 385 | END; 386 | END; 387 | 388 | SDL_MOUSEMOTION: 389 | BEGIN 390 | scaled_x := 1; 391 | scaled_y := 1; 392 | 393 | IF display_scale <> 0 THEN scaled_x := round((event^.motion.x - display_rect^.x) / display_scale); 394 | IF display_scale <> 0 THEN scaled_y := round((event^.motion.y - display_rect^.y) / display_scale); 395 | x := clamp(scaled_x, 0, RISC_SCREEN_WIDTH - 1); 396 | y := clamp(scaled_y, 0, RISC_SCREEN_HEIGHT -1 ); 397 | mouse_is_offscreen := (x <> scaled_x) OR (y <> scaled_y); 398 | IF (mouse_is_offscreen <> mouse_was_offscreen) THEN 399 | 400 | BEGIN 401 | SDL_ShowCursor(b2i(mouse_is_offscreen)); 402 | mouse_was_offscreen := mouse_is_offscreen; 403 | END; 404 | 405 | risc.mouse_moved(x,RISC_SCREEN_HEIGHT - y -1); 406 | END; 407 | 408 | SDL_MOUSEBUTTONDOWN, 409 | SDL_MOUSEBUTTONUP: 410 | BEGIN 411 | down := event^.button.state=SDL_PRESSED; 412 | risc.mouse_button(event^.button.button,down); 413 | END; 414 | 415 | SDL_KEYDOWN, 416 | SDL_KEYUP: 417 | BEGIN 418 | down := (event^.key.state = SDL_PRESSED); 419 | k := event^.key.keysym; 420 | CASE k.sym OF 421 | 422 | SDLK_F12: 423 | BEGIN 424 | write('F12'); 425 | IF down THEN risc.reset; 426 | END; 427 | SDLK_F11: 428 | BEGIN 429 | IF down THEN 430 | BEGIN 431 | fullscreen := NOT(fullscreen); 432 | IF fullscreen THEN SDL_SetWindowFullScreen(window, SDL_WINDOW_FULLSCREEN_DESKTOP) 433 | ELSE SDL_SetWindowFullscreen(window, 0); 434 | END; 435 | END; 436 | SDLK_F4: 437 | BEGIN 438 | IF ((k._mod AND KMOD_ALT) <> 0) THEN 439 | 440 | BEGIN 441 | IF down THEN 442 | 443 | BEGIN 444 | event^.type_ := SDL_QUITEV; 445 | SDL_PUSHEvent(event) 446 | END; 447 | END; 448 | END; 449 | 450 | SDLK_LALT: 451 | BEGIN 452 | risc.mouse_button(2, down); 453 | END; 454 | 455 | ELSE (* else case keyup *) 456 | (* BEGIN *) 457 | len := ps2_encode(event^.key.keysym.scancode,event^.key.state=SDL_PRESSED,scancode_s); 458 | IF len > 0 THEN 459 | 460 | BEGIN 461 | FOR l := 0 TO pred(len) DO 462 | 463 | BEGIN 464 | scancode[l] := ord(scancode_s[succ(l)]); 465 | (* write('|',scancode[l]); *) 466 | END; 467 | END; 468 | risc.keyboard_input(scancode, len); 469 | END; (*else case keyup *) 470 | END; (* case k.sym *) 471 | 472 | END; (* case event^.typ *) 473 | END;(* while poll event *) 474 | risc.set_time(frame_start); 475 | 476 | risc.run(CPU_HZ DIV FPS); 477 | update_texture(risc.get_framebuffer_ptr, texture); 478 | SDL_RenderClear(renderer); 479 | SDL_RenderCopy(renderer, texture, NIL, display_rect); 480 | SDL_RenderPresent(renderer); 481 | 482 | frame_end := SDL_GetTicks; 483 | delay := frame_start + (1000 div FPS) - frame_end; 484 | 485 | IF delay > 0 THEN SDL_Delay(delay); 486 | 487 | exitcode := 0; 488 | END; (* while not done *) 489 | SDL_DestroyRenderer(renderer); 490 | SDL_DestroyWindow(window); 491 | dispose(event); 492 | risc.done; 493 | //shutting down video subsystem 494 | SDL_Quit; 495 | 496 | END; (* proc *) 497 | 498 | 499 | BEGIN 500 | 501 | main; 502 | 503 | END. 504 | -------------------------------------------------------------------------------- /riscps2.pas: -------------------------------------------------------------------------------- 1 | (* Translate SDL scancodes to PS/2 codeset 2 scancodes.*) 2 | 3 | UNIT riscps2; 4 | 5 | 6 | INTERFACE 7 | 8 | 9 | FUNCTION ps2_encode(sdl_scancode: integer; make: boolean; mod_ : word; VAR outs : string): integer; 10 | 11 | 12 | IMPLEMENTATION 13 | 14 | USES keyboard; 15 | 16 | const 17 | SDL_SCANCODE_UNKNOWN=0; 18 | 19 | SDL_SCANCODE_A=4; 20 | SDL_SCANCODE_B=5; 21 | SDL_SCANCODE_C=6; 22 | SDL_SCANCODE_D=7; 23 | SDL_SCANCODE_E=8; 24 | SDL_SCANCODE_F=9; 25 | SDL_SCANCODE_G=10; 26 | SDL_SCANCODE_H=11; 27 | SDL_SCANCODE_I=12; 28 | SDL_SCANCODE_J=13; 29 | SDL_SCANCODE_K=14; 30 | SDL_SCANCODE_L=15; 31 | SDL_SCANCODE_M=16; 32 | SDL_SCANCODE_N=17; 33 | SDL_SCANCODE_O=18; 34 | SDL_SCANCODE_P=19; 35 | SDL_SCANCODE_Q=20; 36 | SDL_SCANCODE_R=21; 37 | SDL_SCANCODE_S=22; 38 | SDL_SCANCODE_T=23; 39 | SDL_SCANCODE_U=24; 40 | SDL_SCANCODE_V=25; 41 | SDL_SCANCODE_W=26; 42 | SDL_SCANCODE_X=27; 43 | SDL_SCANCODE_Y=28; 44 | SDL_SCANCODE_Z=29; 45 | 46 | SDL_SCANCODE_1=30; 47 | SDL_SCANCODE_2=31; 48 | SDL_SCANCODE_3=32; 49 | SDL_SCANCODE_4=33; 50 | SDL_SCANCODE_5=34; 51 | SDL_SCANCODE_6=35; 52 | SDL_SCANCODE_7=36; 53 | SDL_SCANCODE_8=37; 54 | SDL_SCANCODE_9=38; 55 | SDL_SCANCODE_0=39; 56 | 57 | SDL_SCANCODE_RETURN=40; 58 | SDL_SCANCODE_ESCAPE=41; 59 | SDL_SCANCODE_BACKSPACE=42; 60 | SDL_SCANCODE_TAB=43; 61 | SDL_SCANCODE_SPACE=44; 62 | 63 | SDL_SCANCODE_MINUS=45; 64 | SDL_SCANCODE_EQUALS=46; 65 | SDL_SCANCODE_LEFTBRACKET=47; 66 | SDL_SCANCODE_RIGHTBRACKET=48; 67 | SDL_SCANCODE_BACKSLASH=49; 68 | SDL_SCANCODE_NONUSHASH=50; 69 | SDL_SCANCODE_SEMICOLON=51; 70 | SDL_SCANCODE_APOSTROPHE=52; 71 | SDL_SCANCODE_GRAVE=53; 72 | SDL_SCANCODE_COMMA=54; 73 | SDL_SCANCODE_PERIOD=55; 74 | SDL_SCANCODE_SLASH=56; 75 | 76 | SDL_SCANCODE_CAPSLOCK=57; 77 | 78 | SDL_SCANCODE_F1=58; 79 | SDL_SCANCODE_F2=59; 80 | SDL_SCANCODE_F3=60; 81 | SDL_SCANCODE_F4=61; 82 | SDL_SCANCODE_F5=62; 83 | SDL_SCANCODE_F6=63; 84 | SDL_SCANCODE_F7=64; 85 | SDL_SCANCODE_F8=65; 86 | SDL_SCANCODE_F9=66; 87 | SDL_SCANCODE_F10=67; 88 | SDL_SCANCODE_F11=68; 89 | SDL_SCANCODE_F12=69; 90 | 91 | SDL_SCANCODE_INSERT=73; 92 | SDL_SCANCODE_HOME=74; 93 | SDL_SCANCODE_PAGEUP=75; 94 | SDL_SCANCODE_DELETE=76; 95 | SDL_SCANCODE_END=77; 96 | SDL_SCANCODE_PAGEDOWN=78; 97 | SDL_SCANCODE_RIGHT=79; 98 | SDL_SCANCODE_LEFT=80; 99 | SDL_SCANCODE_DOWN=81; 100 | SDL_SCANCODE_UP=82; 101 | 102 | 103 | SDL_SCANCODE_KP_DIVIDE=84; 104 | SDL_SCANCODE_KP_MULTIPLY=85; 105 | SDL_SCANCODE_KP_MINUS=86; 106 | SDL_SCANCODE_KP_PLUS=87; 107 | SDL_SCANCODE_KP_ENTER=88; 108 | SDL_SCANCODE_KP_1=89; 109 | SDL_SCANCODE_KP_2=90; 110 | SDL_SCANCODE_KP_3=91; 111 | SDL_SCANCODE_KP_4=92; 112 | SDL_SCANCODE_KP_5=93; 113 | SDL_SCANCODE_KP_6=94; 114 | SDL_SCANCODE_KP_7=95; 115 | SDL_SCANCODE_KP_8=96; 116 | SDL_SCANCODE_KP_9=97; 117 | SDL_SCANCODE_KP_0=98; 118 | SDL_SCANCODE_KP_PERIOD=99; 119 | 120 | SDL_SCANCODE_NONUSBACKSLASH=100; 121 | SDL_SCANCODE_APPLICATION=101; 122 | 123 | 124 | 125 | 126 | SDL_SCANCODE_LCTRL=224; 127 | SDL_SCANCODE_LSHIFT=225; 128 | SDL_SCANCODE_LALT=226; 129 | SDL_SCANCODE_LGUI=227; 130 | SDL_SCANCODE_RCTRL=228; 131 | SDL_SCANCODE_RSHIFT=229; 132 | SDL_SCANCODE_RALT=230; 133 | SDL_SCANCODE_RGUI=231; 134 | 135 | 136 | SDL_NUM_SCANCODES=512; 137 | 138 | 139 | TYPE 140 | 141 | 142 | codety = 0..255; 143 | 144 | k_infoty = RECORD 145 | code: codety; 146 | END; 147 | 148 | keymapty = ARRAY[0..Pred(SDL_NUM_SCANCODES)] of k_infoty; 149 | 150 | 151 | 152 | VAR 153 | keymap : keymapty; 154 | 155 | //Below the Oberon code for the character recognition. So only the shift and Control 156 | //modifiers are used. 157 | 158 | // original Oberon Code for Control recognition 159 | // PROCEDURE Peek(); 160 | //BEGIN 161 | // IF SYSTEM.BIT(msAdr, 28) THEN 162 | // SYSTEM.GET(kbdAdr, kbdCode); 163 | // IF kbdCode = 0F0H THEN Up := TRUE 164 | // ELSIF kbdCode = 0E0H THEN Ext := TRUE 165 | // ELSE 166 | // IF (kbdCode = 12H) OR (kbdCode = 59H) THEN (*shift*) Shift := ~Up 167 | // ELSIF kbdCode = 14H THEN (*ctrl*) Ctrl := ~Up 168 | // ELSIF ~Up THEN Recd := TRUE (*real key going down*) 169 | // END ; 170 | // Up := FALSE; Ext := FALSE 171 | // END 172 | // END; 173 | //END Peek; 174 | 175 | 176 | 177 | 178 | function ps2_encode(sdl_scancode: integer; make: boolean; mod_ : word; VAR outs : string): integer; 179 | 180 | VAR codes : char; 181 | info : k_infoty; 182 | 183 | BEGIN 184 | info := keymap[sdl_scancode]; 185 | 186 | ps2_encode := 0; 187 | outs := ''; 188 | codes := chr(info.code); 189 | 190 | //IF mod_ = 0 THEN 191 | // 192 | // BEGIN 193 | // IF NOT(make) THEN outs := #$F0; 194 | // outs := outs + codes; 195 | // END 196 | // ELSE 197 | // BEGIN 198 | 199 | IF make THEN 200 | BEGIN 201 | (* press *) 202 | IF ((mod_ and KEYBOARD_LEFT_SHIFT) > 0) THEN outs := outs + #$12; 203 | IF ((mod_ and KEYBOARD_RIGHT_SHIFT) > 0) THEN outs := outs + #$59; 204 | IF ((mod_ AND KEYBOARD_CAPS_LOCK) > 0) THEN outs := outs + #$59; 205 | IF ((mod_ AND KEYBOARD_LEFT_CTRL) > 0) THEN outs := outs + #$14; 206 | IF ((mod_ AND KEYBOARD_RIGHT_CTRL) > 0) THEN outs := outs + #$E0 + #$14; 207 | 208 | outs := outs + codes; 209 | END 210 | else 211 | BEGIN 212 | outs := outs + #$F0 + codes; 213 | (* release *) 214 | IF ((mod_ and KEYBOARD_RIGHT_SHIFT) > 0) THEN outs := outs + #$F0 + #$59; 215 | IF ((mod_ and KEYBOARD_LEFT_SHIFT) > 0) THEN outs := outs + #$F0 + #$12; 216 | IF ((mod_ AND KEYBOARD_CAPS_LOCK) > 0) THEN outs := outs + #$F0 + #$59; 217 | IF ((mod_ AND KEYBOARD_LEFT_CTRL) > 0) THEN outs := outs + #$F0+ #$14; 218 | IF ((mod_ AND KEYBOARD_RIGHT_CTRL) > 0) THEN outs := outs + #$E0 + #$F0 + #$14; 219 | 220 | END; 221 | // END; 222 | 223 | ps2_encode := length(outs); 224 | END; 225 | 226 | BEGIN 227 | 228 | keymap[SDL_SCANCODE_A].code:=($1C); 229 | keymap[SDL_SCANCODE_B].code:=($32); 230 | keymap[SDL_SCANCODE_C].code:=($21); 231 | keymap[SDL_SCANCODE_D].code:=($23); 232 | keymap[SDL_SCANCODE_E].code:=($24); 233 | keymap[SDL_SCANCODE_F].code:=($2B); 234 | keymap[SDL_SCANCODE_G].code:=($34); 235 | keymap[SDL_SCANCODE_H].code:=($33); 236 | keymap[SDL_SCANCODE_I].code:=($43); 237 | keymap[SDL_SCANCODE_J].code:=($3B); 238 | keymap[SDL_SCANCODE_K].code:=($42); 239 | keymap[SDL_SCANCODE_L].code:=($4B); 240 | keymap[SDL_SCANCODE_M].code:=($3A); 241 | keymap[SDL_SCANCODE_N].code:=($31); 242 | keymap[SDL_SCANCODE_O].code:=($44); 243 | keymap[SDL_SCANCODE_P].code:=($4D); 244 | keymap[SDL_SCANCODE_Q].code:=($15); 245 | keymap[SDL_SCANCODE_R].code:=($2D); 246 | keymap[SDL_SCANCODE_S].code:=($1B); 247 | keymap[SDL_SCANCODE_T].code:=($2C); 248 | keymap[SDL_SCANCODE_U].code:=($3C); 249 | keymap[SDL_SCANCODE_V].code:=($2A); 250 | keymap[SDL_SCANCODE_W].code:=($1D); 251 | keymap[SDL_SCANCODE_X].code:=($22); 252 | keymap[SDL_SCANCODE_Y].code:=($35); 253 | keymap[SDL_SCANCODE_Z].code:=($1A); 254 | 255 | keymap[SDL_SCANCODE_1].code:=($16); 256 | keymap[SDL_SCANCODE_2].code:=($1E); 257 | keymap[SDL_SCANCODE_3].code:=($26); 258 | keymap[SDL_SCANCODE_4].code:=($25); 259 | keymap[SDL_SCANCODE_5].code:=($2E); 260 | keymap[SDL_SCANCODE_6].code:=($36); 261 | keymap[SDL_SCANCODE_7].code:=($3D); 262 | keymap[SDL_SCANCODE_8].code:=($3E); 263 | keymap[SDL_SCANCODE_9].code:=($46); 264 | keymap[SDL_SCANCODE_0].code:=($45); 265 | 266 | keymap[SDL_SCANCODE_RETURN].code:= ($5a); 267 | keymap[SDL_SCANCODE_ESCAPE].code:= ($76); 268 | keymap[SDL_SCANCODE_BACKSPACE].code:=($66); 269 | keymap[SDL_SCANCODE_TAB].code:= ($0D); 270 | keymap[SDL_SCANCODE_SPACE].code:= ($29); 271 | 272 | keymap[SDL_SCANCODE_MINUS].code:=($4E); 273 | keymap[SDL_SCANCODE_EQUALS].code:=($55); 274 | keymap[SDL_SCANCODE_LEFTBRACKET].code:=($54); 275 | keymap[SDL_SCANCODE_RIGHTBRACKET].code:=($5B); 276 | keymap[SDL_SCANCODE_BACKSLASH].code:=($5D); 277 | keymap[SDL_SCANCODE_NONUSHASH].code:=($5D); 278 | 279 | keymap[SDL_SCANCODE_SEMICOLON].code:=($4C); 280 | keymap[SDL_SCANCODE_APOSTROPHE].code:=($52); 281 | keymap[SDL_SCANCODE_GRAVE].code:=($0E); 282 | keymap[SDL_SCANCODE_COMMA].code:=($41); 283 | keymap[SDL_SCANCODE_PERIOD].code:=($49); 284 | keymap[SDL_SCANCODE_SLASH].code:=($4A); 285 | 286 | keymap[SDL_SCANCODE_F1].code:=($05); 287 | keymap[SDL_SCANCODE_F2].code:=($06); 288 | keymap[SDL_SCANCODE_F3].code:=($04); 289 | keymap[SDL_SCANCODE_F4].code:=($0c); 290 | keymap[SDL_SCANCODE_F5].code:=($03); 291 | keymap[SDL_SCANCODE_F6].code:=($0B); 292 | keymap[SDL_SCANCODE_F7].code:=($83); 293 | keymap[SDL_SCANCODE_F8].code:=($0A); 294 | keymap[SDL_SCANCODE_F9].code:=($01); 295 | keymap[SDL_SCANCODE_F10].code:=($09); 296 | keymap[SDL_SCANCODE_F11].code:=($78); 297 | keymap[SDL_SCANCODE_F12].code:=($07); 298 | 299 | keymap[SDL_SCANCODE_INSERT].code:=($70); 300 | keymap[SDL_SCANCODE_HOME].code:=($6C); 301 | keymap[SDL_SCANCODE_PAGEUP].code:=($7D); 302 | keymap[SDL_SCANCODE_DELETE].code:=($71); 303 | keymap[SDL_SCANCODE_END].code:=($69); 304 | keymap[SDL_SCANCODE_PAGEDOWN].code:=($7A); 305 | keymap[SDL_SCANCODE_RIGHT].code:=($74); 306 | keymap[SDL_SCANCODE_LEFT].code:=($6B); 307 | keymap[SDL_SCANCODE_DOWN].code:=($72); 308 | keymap[SDL_SCANCODE_UP].code:=($75); 309 | 310 | keymap[SDL_SCANCODE_KP_DIVIDE].code:=($4A); 311 | keymap[SDL_SCANCODE_KP_MULTIPLY].code:=($7C); 312 | keymap[SDL_SCANCODE_KP_MINUS].code:=($7B); 313 | keymap[SDL_SCANCODE_KP_PLUS].code:=($79); 314 | keymap[SDL_SCANCODE_KP_ENTER].code:=($5A); 315 | keymap[SDL_SCANCODE_KP_1].code:=($69); 316 | keymap[SDL_SCANCODE_KP_2].code:=($72); 317 | keymap[SDL_SCANCODE_KP_3].code:=($7A); 318 | keymap[SDL_SCANCODE_KP_4].code:=($6B); 319 | keymap[SDL_SCANCODE_KP_5].code:=($73); 320 | keymap[SDL_SCANCODE_KP_6].code:=($74); 321 | keymap[SDL_SCANCODE_KP_7].code:=($6C); 322 | keymap[SDL_SCANCODE_KP_8].code:=($75); 323 | keymap[SDL_SCANCODE_KP_9].code:=($7D); 324 | keymap[SDL_SCANCODE_KP_0].code:=($70); 325 | keymap[SDL_SCANCODE_KP_PERIOD].code:=($71); 326 | 327 | keymap[SDL_SCANCODE_NONUSBACKSLASH].code:=($61); 328 | keymap[SDL_SCANCODE_APPLICATION].code:=($2F); 329 | 330 | keymap[SDL_SCANCODE_LCTRL].code:=($14); 331 | keymap[SDL_SCANCODE_LSHIFT].code:=($12); 332 | keymap[SDL_SCANCODE_LALT].code:=($11); 333 | keymap[SDL_SCANCODE_LGUI].code:=($1F); 334 | keymap[SDL_SCANCODE_RCTRL].code:=($14); 335 | keymap[SDL_SCANCODE_RSHIFT].code:=($59); 336 | keymap[SDL_SCANCODE_RALT].code:=($11); 337 | keymap[SDL_SCANCODE_RGUI].code:=($27); 338 | 339 | 340 | 341 | 342 | 343 | 344 | END. 345 | -------------------------------------------------------------------------------- /riscsd.pas: -------------------------------------------------------------------------------- 1 | (********************************* 2 | Reading and writing to and from 3 | the Oberon filesystem, which is kept 4 | in one single file. (MG) 5 | 6 | *********************************) 7 | 8 | UNIT riscsd; 9 | 10 | 11 | INTERFACE 12 | 13 | USES 14 | Platform, Filesystem, FATFS, sysutils, riscglob; 15 | 16 | CONST BUFSBYTE = 512; 17 | BUFSWORD = BUFSBYTE DIV 4; 18 | 19 | TYPE 20 | diskstatetype = (diskCommand, diskRead, diskWrite, diskWriting); 21 | 22 | 23 | bufty = ARRAY[0..Pred(BUFSWORD) ] OF uint32_t; 24 | buftyp2 = ARRAY[0..Pred(BUFSWORD)+2] OF uint32_t; 25 | 26 | bytebufty = ARRAY[0..pred(BUFSBYTE) ] OF uint8_t; 27 | 28 | Diskty = OBJECT 29 | PRIVATE 30 | state : diskstatetype; 31 | myfile: THandle; 32 | rx_buf: bufty; 33 | rx_idx: longint; 34 | tx_buf: buftyp2; 35 | tx_cnt: longint; 36 | tx_idx: longint; 37 | offset : uint32_t; 38 | PUBLIC 39 | sdcard : Boolean; 40 | CONSTRUCTOR init(filename : string); 41 | PROCEDURE run_command; 42 | PRIVATE 43 | PROCEDURE read_sector(VAR buffer : bufty); 44 | PROCEDURE read_sector2(VAR buffer : buftyp2); 45 | PROCEDURE write_sector(buffer : bufty); 46 | PUBLIC 47 | FUNCTION read_: uint32_t; 48 | PROCEDURE write_(value: uint32_t); 49 | DESTRUCTOR done; 50 | 51 | END; 52 | 53 | 54 | VAR disk : Diskty; 55 | 56 | IMPLEMENTATION 57 | 58 | 59 | CONSTRUCTOR diskty.init(filename : string); 60 | 61 | VAR buffer : bufty; 62 | 63 | BEGIN 64 | ActivityLEDON; 65 | // writeln(' Now in diskty.init'); 66 | {We may need to wait a couple of seconds for any drive to be ready} 67 | // WriteLn('Waiting for drive C:\'); 68 | while not DirectoryExists('C:\') do 69 | BEGIN 70 | {Sleep for a second} 71 | Sleep(1000); 72 | END; 73 | // writeLn('C:\ drive is ready'); 74 | 75 | 76 | state := diskCommand; 77 | sdcard := False; 78 | buffer[0] := 0; 79 | {$I-} 80 | myfile := fileOpen(filename, fmOpenReadWrite); 81 | {$I+} 82 | IF myfile = 0 THEN 83 | BEGIN 84 | // writeln('Can''t open file : ', filename,' ', ioresult); 85 | // GraphicWindowDrawText(GraphicHandle1, filename, 40,10); 86 | exit; 87 | END; 88 | 89 | (* Check FOR filesystem-only image, starting directly at sector 1 (DiskAdr 29) *) 90 | read_sector(buffer); 91 | IF (buffer[0] = $9B1EA38D) THEN offset := $80002 ELSE offset := 0; 92 | // writeln(' File Offset : ', offset); 93 | // writeln('Buffer[0] : ',buffer[0]); 94 | sdcard := True; 95 | ActivityLEDOff; 96 | END; 97 | 98 | 99 | 100 | DESTRUCTOR diskty.done; 101 | 102 | BEGIN 103 | fileclose(myfile); 104 | END; 105 | 106 | PROCEDURE diskty.write_(value: uint32_t); 107 | 108 | BEGIN 109 | inc(tx_idx); 110 | (* case statements in Pascal are breaking the case loop if 111 | the first condition is true, not so in C *) 112 | CASE state of 113 | diskCommand: BEGIN 114 | IF ((byte(value)<>$FF) OR (rx_idx<>0)) THEN 115 | BEGIN 116 | rx_buf[rx_idx]:= value; 117 | inc(rx_idx); 118 | IF rx_idx = 6 THEN 119 | 120 | BEGIN 121 | run_command; 122 | rx_idx:= 0; 123 | END; 124 | END; 125 | END; 126 | diskRead: BEGIN 127 | IF tx_idx = tx_cnt THEN 128 | 129 | BEGIN 130 | state:= diskCommand; 131 | tx_cnt:= 0; 132 | tx_idx:= 0; 133 | END; 134 | END; 135 | 136 | diskWrite: BEGIN 137 | IF value = 254 THEN state:= diskWriting; 138 | END; 139 | 140 | diskWriting: BEGIN 141 | IF rx_idx < BUFSWORD THEN rx_buf[rx_idx]:= value; 142 | inc(rx_idx); 143 | IF rx_idx = BUFSWORD THEN write_sector(rx_buf); 144 | 145 | IF rx_idx = 130 THEN 146 | BEGIN 147 | tx_buf[0] := 5; 148 | tx_cnt := 1; 149 | tx_idx:= -1; 150 | rx_idx:= 0; 151 | state:= diskCommand; 152 | END; 153 | END; 154 | END;{case} 155 | END; 156 | 157 | FUNCTION diskty.read_: uint32_t; 158 | 159 | VAR resu: uint32_t; 160 | 161 | BEGIN 162 | IF (tx_idx >= 0) AND (tx_idx < tx_cnt) THEN 163 | 164 | BEGIN 165 | resu := tx_buf[tx_idx]; 166 | END 167 | ELSE 168 | BEGIN 169 | resu := 255; 170 | END; 171 | read_ := resu; 172 | END; 173 | 174 | PROCEDURE diskty.run_command; 175 | 176 | VAR cmd: uint32_t; 177 | arg: uint32_t; 178 | (* myreadpos, mywritepos : longint; *) 179 | 180 | BEGIN 181 | cmd := rx_buf[0]; 182 | arg := (rx_buf[1] shl 24) or (rx_buf[2] shl 16) or (rx_buf[3] shl 8) or rx_buf[4]; 183 | 184 | CASE cmd OF 185 | 81: BEGIN 186 | state:= diskRead; 187 | tx_buf[0] := 0; 188 | tx_buf[1] := 254; 189 | (* myreadpos :=*) fileseek(myfile, (arg - offset) * BUFSBYTE, fsFromBeginning); 190 | read_sector2(tx_buf); 191 | tx_cnt:= 2 + BUFSWORD; 192 | END; 193 | 194 | 88: BEGIN 195 | state:= diskWrite; 196 | (* mywritepos := *) fileseek(myfile, (arg - offset) * BUFSBYTE, fsFromBeginning); 197 | tx_buf[0] := 0; 198 | tx_cnt := 1; 199 | END; 200 | ELSE 201 | BEGIN 202 | tx_buf[0] := 0; 203 | tx_cnt := 1; 204 | END; 205 | END;(*case*) 206 | 207 | tx_idx := -1; 208 | END; 209 | 210 | PROCEDURE diskty.read_sector(VAR buffer : bufty); 211 | 212 | VAR bytes: bytebufty; 213 | i : 0..pred(BUFSWORD); 214 | i2 : 0..pred(BUFSBYTE); 215 | 216 | 217 | BEGIN 218 | FOR i2 := 0 TO pred(BUFSBYTE) DO 219 | 220 | BEGIN 221 | bytes[i2] := 0; 222 | END; 223 | 224 | fileread(myfile, bytes, BUFSBYTE); 225 | 226 | FOR i := 0 to Pred(BUFSWORD) DO 227 | 228 | BEGIN 229 | buffer[i]:= longword(bytes[i*4+0]) or (longword(bytes[i*4+1]) shl 8) or (longword(bytes[i*4+2]) shl 16) or (longword(bytes[i*4+3]) shl 24); 230 | END; 231 | 232 | END; 233 | 234 | 235 | PROCEDURE diskty.read_sector2(VAR buffer : buftyp2); 236 | 237 | VAR bytes : bytebufty; 238 | i : 0..pred(BUFSWORD); 239 | i2 : 0..pred(BUFSBYTE); 240 | 241 | BEGIN 242 | FOR i2 := 0 to pred(BUFSBYTE) DO 243 | 244 | BEGIN 245 | bytes[i2] := 0; 246 | END; 247 | 248 | fileread(myfile, bytes, BUFSBYTE); 249 | 250 | FOR i := 0 to Pred(BUFSWORD) DO 251 | 252 | BEGIN 253 | buffer[i+2]:= longword(bytes[i*4+0]) or (longword(bytes[i*4+1]) shl 8) or (longword(bytes[i*4+2]) shl 16) or (longword(bytes[i*4+3]) shl 24); 254 | END; 255 | 256 | END; 257 | 258 | 259 | 260 | 261 | PROCEDURE diskty.write_sector(buffer : bufty); 262 | 263 | VAR bytes: bytebufty; 264 | i : 0..pred(BUFSWORD); 265 | BEGIN 266 | 267 | FOR i := 0 to Pred(BUFSWORD) DO 268 | 269 | BEGIN 270 | bytes[i*4+0]:= byte((buffer[i]) and $FF); 271 | bytes[i*4+1]:= byte((buffer[i] shr 8) and $FF); 272 | bytes[i*4+2]:= byte((buffer[i] shr 16) and $FF); 273 | bytes[i*4+3]:= byte((buffer[i] shr 24) and $FF); 274 | END; 275 | filewrite(myfile, bytes, BUFSBYTE); 276 | END; 277 | 278 | END. 279 | -------------------------------------------------------------------------------- /ultiboberont.lpr: -------------------------------------------------------------------------------- 1 | PROGRAM ultiboberont; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | 6 | //# ULTIBOBERON / Port of Peter de Wachters OBERON RISC Emulator to Ultibo 7 | 8 | //14.08.2016 9 | //To do: 10 | //- serial GPIO etc. 11 | //- test on RPI 0, 1, 3 12 | 13 | 14 | //# Hints, Design, Problems, To do's etc. 15 | // 13.08.2016 16 | //1. The software is __pre-beta__! 17 | //2. There is a bug in the USB interface in Ultibo. You __must__ use an USB hub to 18 | // connect mouse and keyboard. At least one of both must be connected via the hub. 19 | //There seems to be a DMA problem for slow HID devices. Its a known issue. 20 | //3. Due to lack of time, I have the code only tested for the RPI2. 21 | //4. I have realised the sw in one single thread follwing Wirths original design. 22 | //5. The code is not optimized for performance at all. 23 | //6. The RISC5 code and the FPU code is from 2014, the latest FPU improvements 24 | //etc. are not coded yet. 25 | //7. The OBERON file system is encapsulated in one single file oberon.dsk, it 26 | //would be nice for sure, to mirror it in FAT or similar. 27 | //8. The disk image is from Peter de Wachter at: 28 | //https://github.com/pdewacht/oberon-risc-emu/blob/master/DiskImage/Oberon-2016-08-02.dsk 29 | //9. Ultibo has no command line options, so everything is hard coded. 30 | //10. the F4 and F12 keys are not working yet. 31 | //11. For Non-Oberonians: Before you play with the software please read: 32 | //https://www.inf.ethz.ch/personal/wirth/ProjectOberon/UsingOberon.pdf 33 | //The using of the mouse and the windows (here called viewers) is different 34 | //from the Windows or OsX world. Even if Allen, Wozniak, Gates and Jobs said that 35 | //they have been at least "inspired" by the ALTO system they had seen at Xerox. 36 | //12. You need a 3 button mouse. 37 | //13. .. and many more.. 38 | 39 | //06.jul.2016 40 | //- is now also compiling on wine but yu have to adapt the paths 41 | //to drive Z: in /home/markus/Ultibo/Core/fpc/3.1.1/bin/i386-win32/rpi2.cfg 42 | 43 | (******************************************************************************) 44 | // 45 | //# ULTIBOBERON / Port of Peter de Wachters OBERON RISC Emulator to Ultibo 46 | //============================================ 47 | //[Ultibo](http://www.ultibo.org) 48 | // 49 | //## For the Oberonians: 50 | //-------------------- 51 | // 52 | //### What is Ultibo ? 53 | // 54 | //citation from the Ultibo web-site: 55 | // 56 | //"Ultibo core is an embedded or bare metal development environment for Raspberry Pi. 57 | //It is not an operating system but provides many of the same services as an OS, 58 | //things like memory management, networking, filesystems and threading plus 59 | //much more." 60 | // 61 | //What they write only in the footnote is: 62 | // 63 | //"Ultibo is written entirely in Free Pascal and is designed to act as a unikernel 64 | //or a kernel in a run time library. That means when you compile your application 65 | //the necessary parts of Ultibo are automatically included by the compiler so 66 | //that your program runs without needing an operating system." 67 | // 68 | //For all, not yet knowing what the Raspberry Pi is: 69 | // 70 | //### What is the Raspberry Pi ? 71 | //"The Raspberry Pi is a series of credit card-sized single-board computers 72 | //developed in the United Kingdom by the Raspberry Pi Foundation to promote the 73 | //teaching of basic computer science in schools and developing countries" 74 | //https://en.wikipedia.org/wiki/Raspberry_Pi 75 | // 76 | //And the most important thing: The RPI is cheap: 77 | //The smallest model costs here in Germany incl. tax 15 EUR, the biggest iron 78 | //38 EUR. Here we have 4 ARM cores @ 1 GHz, HDMI, USB, Network interface, PIO, LED,audio, etc. etc. + 1 GByte + SD card etc. 79 | // 80 | //The RPI is mostly used with LINUX. That's nice but with LINUX you are far, far 81 | //away from the hardware. And its quite crazy for my opinion, to use Gigabytes 82 | //of code to blink a LED. 83 | // 84 | //###So what is Ultibo for me: 85 | // The ideal tool! You have more or less infinite RAM and power, 86 | //you can and MUST write all programs in PASCAL, and you have with Lazarus 87 | //a real nice and fast development environment for Windows and Linux (with Wine) 88 | // 89 | // 90 | //## For the Ultiboys and Ultigirls: 91 | // 92 | //### What is OBERON: 93 | //1. OBERON is a programming language designed from 1988 by the Turing award winner 94 | // Niklaus Wirth, the inventor of PASCAL and some other programming languages. 95 | //OBERON is quite similar to PASCAL with object extension and units as known from 96 | //Turbo Pascal 6.0+. 97 | //2. OBERON is also, and that's sometimes confusing, the name of a complete operating 98 | // system, including graphical user interface with mouse control, an editor, compiler, libraries etc. 99 | //Wirth was 1977/78 at the XEROX park labs in Palo Alto, where he worked with the 100 | //ALTO workstation. This was the first computer with a mouse and a graphical user 101 | //interface. In 1986 Wirth developed his own 32bit computer called CERES incl. 102 | //his own operating system written in his own language called OBERON. 103 | //From 2013 Wirth was developing a new workstation based on one single FPGA and called it 104 | //__Project OBERON__. See http://www.projectoberon.com/ or 105 | //http://www.xilinx.com/support/documentation/xcell_articles/91-5-oberon-system-implemented-on-a-low-cost-fpga-board.pdf 106 | //or 107 | //https://www.computer.org/csdl/mags/co/2012/07/mco2012070008.pdf 108 | // 109 | //The complete system including the kernel, the editor, the compiler and the GUI 110 | //has about 10000 (ten thousand) lines of code. The Linux 4.x kernel has about 15 million lines of code. 111 | // 112 | // 113 | // 114 | //## For both: 115 | //Project Oberon aka FPGA OBERON is a very interesting system, but fiddling around with FPGAs, 116 | // especially with the development environments of Xilinx or Altera is, friendly spoken, demanding. 117 | // Even producing a video signal for a modern interface like HDMI or display port with a FPGA 118 | // is for example 10 times more complex then the whole so called RISC5 processor for the Project OBERON. 119 | // 120 | //In 2014 Peter de Wachter has written an emulator for Project OBERON on the PC. 121 | //A nice project, but written in C, a non-Wirthian languge. So i made a port of his program to (Free)-Pascal. The emulator works fine, but making the graphic 122 | //and the mouse interface with the SDL library was a typical example for the 123 | //complexity of Linux and Windows. 124 | // 125 | //## My intension to bring OBERON to Ultibo on the RPI: 126 | // 127 | //0. Having a total type save Wirthian system! 128 | //1. A proof of concept and test for Ultibo. 129 | //2. Having an OBERON system for 15 EUR 130 | //3. Having direct hardware access from OBERON. Up to now only the Blink.Run works, but integrate GPIO, the serial interface etc. may be done with only a few 131 | //lines of code. 132 | //4. Its quite easy to expand OBERON with some TCP/IP functionality, which is already part of the Ultibo libraries. 133 | //5. Maybe in the future OBERON can be used as a kind of inelligent shell, including 134 | //editor, compiler etc. for Ultibo. 135 | // 136 | // 137 | //#Licenses 138 | // Copyright: (c) Markus Greim, August 2016 139 | //Permission to use, copy, modify, and/or distribute this software for 140 | //any purpose with or without fee is hereby granted, provided that the 141 | //below copyright notice and this permission notice appear in all 142 | //copies. 143 | // 144 | //THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL 145 | //WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED 146 | //WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE 147 | //AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL 148 | //DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR 149 | //PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 150 | //TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 151 | //PERFORMANCE OF THIS SOFTWARE. 152 | 153 | // 154 | //##Ultibo 155 | //core is licensed under the GNU Lesser General Public License v2.1 and is 156 | //freely available to use, modify and distribute within the terms of the license. 157 | //The license includes an exception statement to permit static linking with files 158 | //that are licensed under different terms. 159 | // 160 | //##Free-Pascal 161 | //http://www.freepascal.org/faq.var#general-license 162 | // 163 | //##Oberon 164 | //Project Oberon, Revised Edition 2013 165 | // 166 | //Book copyright (C)2013 Niklaus Wirth and Juerg Gutknecht; 167 | //software copyright (C)2013 Niklaus Wirth (NW), Juerg Gutknecht (JG), Paul 168 | //Reed (PR/PDR). 169 | // 170 | //Permission to use, copy, modify, and/or distribute this software and its 171 | //accompanying documentation (the "Software") for any purpose with or 172 | //without fee is hereby granted, provided that the above copyright notice 173 | //and this permission notice appear in all copies. 174 | // 175 | //THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHORS DISCLAIM ALL WARRANTIES 176 | //WITH REGARD TO THE SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF 177 | //MERCHANTABILITY, FITNESS AND NONINFRINGEMENT. IN NO EVENT SHALL THE 178 | //AUTHORS BE LIABLE FOR ANY CLAIM, SPECIAL, DIRECT, INDIRECT, OR 179 | //CONSEQUENTIAL DAMAGES OR ANY DAMAGES OR LIABILITY WHATSOEVER, WHETHER IN 180 | //AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 181 | //CONNECTION WITH THE DEALINGS IN OR USE OR PERFORMANCE OF THE SOFTWARE. 182 | // 183 | // 184 | //##All other copyright things below, I hope. 185 | // 186 | //Below the Radme file of the original port: 187 | // 188 | //Oberon RISC Emulator for Pascal 189 | //=============================== 190 | // 191 | //translation of the Oberon Risc Emulator from 192 | //Peter De Wachter to Freepascal. 193 | // 194 | //I was using: 195 | // 196 | //SDL2 headers translation for Free Pascal 197 | // https://bitbucket.org/p_daniel/sdl-2-for-free-pascal-compiler 198 | // from P. Daniel 199 | // 200 | //SDL 201 | // Simple DirectMedia Layer 202 | // Copyright (C) 1997-2013 Sam Lantinga 203 | // [SDL2](http://libsdl.org/). 204 | // 205 | //The Oberon bootload code 206 | // risc_boot.inc 207 | //from Paul Reed at http://projectoberon.com/ 208 | // 209 | //Original Project Oberon 210 | // design and source code copyright © 1991–2014 Niklaus Wirth (NW) and Jürg Gutknecht (JG) 211 | //at http://www.inf.ethz.ch/personal/wirth/ProjectOberon/ 212 | //or http://projectoberon.com/ 213 | // 214 | //Requirements: the freepacal compiler see: 215 | // 216 | //[Freepascal](https://github.com/graemeg/freepascal) 217 | //or 218 | //http://www.freepascal.org/ 219 | // 220 | //09.jun.2016 221 | //- Added the latest dsk file from Peter de Wachter 222 | //- removed 2 calls in SDL2.pas because they are not compatible with libSDL2-2.0.0 223 | // 224 | //you may find this code at: 225 | // 226 | //https://github.com/MGreim/riscpas_repo 227 | // 228 | //================================================================================ 229 | // 230 | //below the orignal README.md from Peter de Wachter 231 | // 232 | //================================================================================ 233 | // 234 | // 235 | // 236 | // 237 | // 238 | //Oberon RISC Emulator 239 | //==================== 240 | // 241 | //This is an emulator for the Oberon RISC machine. For more information, see: 242 | //http://www.inf.ethz.ch/personal/wirth/ and http://projectoberon.com/. 243 | // 244 | //Requirements: a C99 compiler (e.g. [GCC](http://gcc.gnu.org/), 245 | //[clang](http://clang.llvm.org/)) and [SDL2](http://libsdl.org/). 246 | // 247 | //A suitable disk image can be downloaded from http://projectoberon.com/ (in 248 | //S3RISCinstall.zip). **Warning**: Images downloaded before 2014-03-29 have 249 | //broken floating point. 250 | // 251 | //Current emulation status 252 | //------------------------ 253 | // 254 | //* CPU 255 | // * No known bugs. 256 | // 257 | //* Keyboard and mouse 258 | // * OK. Note that Oberon assumes you have a US keyboard layout and 259 | // a three button mouse. 260 | // * The left alt key can now be used to emulate a middle click. 261 | // 262 | //* Display 263 | // * OK. You can adjust the colors by editing `sdl-main.c`. 264 | // * Use F11 to toggle full screen display. 265 | // 266 | //* SD-Card 267 | // * Very inaccurate, but good enough for Oberon. If you're going to 268 | // hack the SD card routines, you'll need to use real hardware. 269 | // 270 | //* RS-232 271 | // * Implements PCLink protocol to send/receive single files at a time 272 | // e.g. to receive Test.Mod into Oberon, run PCLink1.Start, 273 | // then in host risc current directory, `echo Test.Mod > PCLink.REC` 274 | // * Thanks to Paul Reed 275 | // 276 | //* Network 277 | // * Not implemented. 278 | // 279 | //* LEDs 280 | // * Printed on stdout. 281 | // 282 | //* Reset button 283 | // * Press F12 to abort if you get stuck in an infinite loop. 284 | // 285 | // 286 | //Copyright 287 | //--------- 288 | // 289 | //Copyright © 2014 Peter De Wachter 290 | // 291 | //Permission to use, copy, modify, and/or distribute this software for 292 | //any purpose with or without fee is hereby granted, provided that the 293 | //above copyright notice and this permission notice appear in all 294 | //copies. 295 | // 296 | //THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL 297 | //WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED 298 | //WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE 299 | //AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL 300 | //DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR 301 | //PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 302 | //TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 303 | //PERFORMANCE OF THIS SOFTWARE. 304 | 305 | 306 | (*****************************************************************************) 307 | 308 | 309 | 310 | {Declare some units used by this program.} 311 | USES 312 | // Units to run Ultibo 313 | GlobalConst, 314 | GlobalTypes, 315 | Platform, 316 | Threads, 317 | BCM2836, 318 | BCM2709, 319 | SysUtils, 320 | Console, 321 | GraphicsConsole, 322 | 323 | 324 | // With this following block of units we can update 325 | // the SD card via telnet. The remote computer is xx.29 326 | // the path is /var/www 327 | // unfortunately a sunbdirectory doesnt work with my apache2 328 | // not required, only helpful for rapid developement 329 | // otherwise you have to fiddle around 330 | // with the SD card. 331 | //---------------------------------------------------------------------- 332 | Shell, {Add the Shell unit just for some fun} 333 | ShellFileSystem, {Plus the File system shell commands} 334 | ShellUpdate, //<- Add this extra one to enable the update commands 335 | RemoteShell, {And the RemoteShell unit so we can Telnet to our Pi} 336 | SMSC95XX, {And the driver for the Raspberry Pi network adapter} 337 | //-------------------------------------------------------------- 338 | // Mouse and Keyboard 339 | 340 | DWCOTG, {We need to include the USB host driver for the Raspberry Pi} 341 | Mouse, 342 | Keyboard, {Keyboard uses USB so that will be included automatically} 343 | 344 | // All the Oberon stuff 345 | risccore, riscglob, riscps2; 346 | 347 | const 348 | BLACK = $657b83; 349 | WHITE = $fdf6e3; 350 | 351 | 352 | TYPE 353 | cachety = ARRAY[0..Pred(RISC_SCREEN_WIDTH*RISC_SCREEN_HEIGHT DIV 32)] of uint32_t; 354 | bufferty = ARRAY[0..Pred(RISC_SCREEN_WIDTH*RISC_SCREEN_HEIGHT)] OF uint32_t; 355 | bufferxyty = ARRAY[0..pred(RISC_SCREEN_WIDTH), 0..pred(RISC_SCREEN_HEIGHT)] OF uint32; 356 | 357 | 358 | VAR 359 | GraphicHandle1 :TWindowHandle; 360 | cache: cachety; 361 | buffer, bufferlin: bufferty; 362 | bufferxy : bufferxyty; 363 | neux, neuy, altx , alty : longint; 364 | 365 | mybutton : integer; 366 | 367 | 368 | PROCEDURE init_texture; 369 | VAR i : longint; 370 | xi, yi : longint; 371 | 372 | BEGIN 373 | fillchar(cache,sizeof(cache), 0); 374 | 375 | FOR i := 0 TO Pred(RISC_SCREEN_WIDTH*RISC_SCREEN_HEIGHT) DO 376 | 377 | BEGIN 378 | buffer[i] := BLACK; 379 | END; 380 | 381 | FOR xi := 0 TO Pred(RISC_SCREEN_WIDTH) DO 382 | 383 | BEGIN 384 | FOR yi := 0 TO Pred(RISC_SCREEN_HEIGHT) DO 385 | BEGIN 386 | bufferxy[xi, yi] := BLACK; 387 | END; 388 | 389 | END; 390 | 391 | GraphicsWindowDrawImage(GraphicHandle1, 1, 1, @buffer, RISC_SCREEN_WIDTH, RISC_SCREEN_HEIGHT,COLOR_FORMAT_UNKNOWN); 392 | // FrameBufferConsoleDrawImage(ConsoleDeviceGetDefault, 1, 1, @buffer, RISC_SCREEN_WIDTH, RISC_SCREEN_HEIGHT,COLOR_FORMAT_UNKNOWN, 0); 393 | 394 | END; 395 | 396 | 397 | 398 | 399 | 400 | 401 | PROCEDURE update_texture(framebufferpointer : uint32_t); 402 | 403 | VAR 404 | 405 | 406 | idx: integer; 407 | pixels: uint32_t; 408 | ptr: Pointer; 409 | 410 | 411 | line, ymin, ymax, yi, laufy : 0..RISC_SCREEN_HEIGHT; 412 | col, xmin, xmax, xi, laufx : 0..RISC_SCREEN_WIDTH; 413 | bufferindex, i : 0..RISC_SCREEN_WIDTH*RISC_SCREEN_HEIGHT; 414 | b : 0..pred(32); 415 | 416 | BEGIN (* TODO: move dirty rectangle tracking into emulator core?*) 417 | ymin := RISC_SCREEN_HEIGHT; 418 | ymax := 0; 419 | xmin := RISC_SCREEN_WIDTH; 420 | xmax := 0; 421 | 422 | idx := 0; 423 | FOR line := RISC_SCREEN_HEIGHT-1 DOWNTO 0 DO 424 | 425 | BEGIN 426 | FOR col := 0 TO pred(RISC_SCREEN_WIDTH DIV 32) DO 427 | BEGIN 428 | pixels := risc.RAM[idx+framebufferpointer]; 429 | IF pixels <> cache[idx] THEN 430 | BEGIN 431 | cache[idx] := pixels; 432 | 433 | bufferindex := line*RISC_SCREEN_WIDTH + col * 32; 434 | yi := line; 435 | IF yi < ymin THEN ymin := yi; 436 | IF yi > ymax THEN ymax := yi; 437 | 438 | 439 | FOR b := 0 TO Pred(32) DO 440 | 441 | BEGIN 442 | xi := col * 32 +b; 443 | 444 | IF (pixels AND 1) > 0 THEN buffer[bufferindex] := WHITE ELSE buffer[bufferindex] := BLACK; 445 | IF (pixels AND 1) > 0 THEN bufferxy[xi, yi] := WHITE ELSE bufferxy[xi, yi] := BLACK; 446 | IF xi < xmin THEN xmin := xi; 447 | IF xi > xmax THEN xmax := xi; 448 | inc(bufferindex); 449 | pixels := pixels SHR 1; 450 | END; 451 | END;(*IF*) 452 | inc(idx); 453 | END;(*for col *) 454 | END;(*for line *) 455 | 456 | // GraphicsWindowDrawImage(GraphicHandle1, 0, 0, @buffer, RISC_SCREEN_WIDTH, RISC_SCREEN_HEIGHT,COLOR_FORMAT_UNKNOWN); 457 | 458 | i := 0; 459 | IF ymin <= ymax THEN 460 | 461 | BEGIN 462 | 463 | FOR laufy := ymin TO ymax DO 464 | 465 | BEGIN 466 | FOR laufx := xmin TO xmax DO 467 | BEGIN 468 | bufferlin[i] := bufferxy[laufx, laufy]; 469 | inc(i); 470 | END; 471 | END; 472 | 473 | ptr:= @bufferlin; 474 | GraphicsWindowDrawImage(GraphicHandle1, xmin, ymin, ptr, (xmax - xmin +1), (ymax - ymin +1),COLOR_FORMAT_UNKNOWN); 475 | 476 | END; 477 | END; 478 | 479 | 480 | FUNCTION clamp(x, min, max : integer) : integer; 481 | 482 | VAR z : integer; 483 | 484 | BEGIN 485 | z := round(x); 486 | clamp := z; 487 | IF z < min THEN clamp := min; 488 | IF z > max THEN clamp := max; 489 | END; 490 | 491 | 492 | 493 | PROCEDURE mymouse; 494 | 495 | VAR 496 | MouseData:TMouseData; 497 | mcount : longword; 498 | 499 | 500 | BEGIN 501 | IF MousePeek = ERROR_SUCCESS THEN 502 | BEGIN 503 | if MouseRead(@MouseData,SizeOf(MouseData),mCount) = ERROR_SUCCESS then 504 | BEGIN 505 | neux := altx + MouseData.OffsetX; 506 | neuy := alty + MouseData.OffsetY; 507 | neux := clamp(neux, 0, RISC_SCREEN_WIDTH); 508 | neuy := clamp(neuy, 0, RISC_SCREEN_HEIGHT); 509 | IF ((neux <> altx) OR (neuy <> alty)) THEN risc.mouse_moved(neux, RISC_SCREEN_HEIGHT-neuy -1); 510 | altx := neux; 511 | alty := neuy; 512 | IF MouseData.Buttons <> 0 THEN 513 | 514 | BEGIN 515 | mybutton := 0; 516 | IF (MouseData.Buttons and MOUSE_LEFT_BUTTON) <> 0 THEN mybutton := 1; 517 | IF (MouseData.Buttons and MOUSE_MIDDLE_BUTTON) <> 0 THEN mybutton := 2; 518 | IF (MouseData.Buttons and MOUSE_RIGHT_BUTTON) <> 0 THEN mybutton := 3; 519 | IF mybutton > 0 THEN 520 | BEGIN 521 | risc.mouse_button(mybutton, True); 522 | END; 523 | END 524 | ELSE 525 | BEGIN 526 | IF mybutton > 0 THEN 527 | BEGIN 528 | risc.mouse_button(mybutton, False); 529 | mybutton := 0; 530 | END; 531 | END; 532 | 533 | MouseFlush; 534 | 535 | END; 536 | 537 | END; (* END MousePeek *) 538 | END; 539 | 540 | FUNCTION mykeyboard : longword; 541 | 542 | VAR 543 | 544 | KeyBoardData : TKeyboardData; 545 | Count : longword; 546 | mymode_ : word; 547 | mymake : Boolean; 548 | 549 | scancode_s : string; 550 | len : 0..pred(maxkeybufsize); 551 | l : 0..pred(maxkeybufsize); 552 | scancode: keybufty; 553 | 554 | 555 | BEGIN 556 | IF keyboardPeek = ERROR_SUCCESS THEN 557 | BEGIN 558 | 559 | IF (KeyboardRead(@KeyboardData,SizeOf(KeyboardData), Count) = ERROR_SUCCESS) THEN 560 | 561 | BEGIN 562 | mykeyboard := KeyboardData.ScanCode; 563 | mymode_ := 0; 564 | mymake := False; 565 | IF (((KeyboardData.Modifiers AND $4000) > 0) OR ((KeyboardData.Modifiers AND $8000) > 0)) THEN mymake := True; 566 | IF ((KeyboardData.Modifiers AND $2000) > 0) THEN mymake := False; 567 | mymode_ := KeyboardData.Modifiers AND $0FFF; 568 | len := ps2_encode(KeyboardData.ScanCode,mymake, mymode_, scancode_s); 569 | IF len > 0 THEN 570 | 571 | BEGIN 572 | FOR l := 0 TO pred(len) DO 573 | 574 | BEGIN 575 | scancode[l] := ord(scancode_s[succ(l)]); 576 | END; 577 | END; 578 | risc.keyboard_input(scancode, len); 579 | END; 580 | 581 | END; 582 | 583 | END; 584 | 585 | 586 | 587 | 588 | PROCEDURE riscmainloop; 589 | 590 | VAR 591 | done: bool; 592 | frame_start: longword; 593 | frame_end, starttime: longword; 594 | 595 | mydelay, counter: longint; 596 | 597 | BEGIN 598 | 599 | risc.init('C:\oberon.dsk', '', ''); 600 | done := False; 601 | 602 | starttime := getTickCount64; 603 | counter := 0; 604 | neux := 0; 605 | neuy := 0; 606 | altx := 0; 607 | alty := 0; 608 | WHILE NOT(done) DO 609 | 610 | BEGIN 611 | frame_start := getTickCount64 - starttime; 612 | risc.set_time(frame_start); 613 | mykeyboard; 614 | // sleep(1); 615 | mymouse; 616 | // toggleLED; 617 | risc.run(CPU_HZ DIV FPS); 618 | inc(counter); 619 | update_texture(risc.get_framebuffer_ptr); 620 | 621 | frame_end := getTickCount64 - starttime; 622 | mydelay := frame_start + (1000 div FPS) - frame_end; 623 | 624 | IF ((mydelay > 0) AND (mydelay < 20)) THEN sleep(mydelay); 625 | 626 | exitcode := 0; 627 | END; (* while not done *) 628 | risc.done; 629 | 630 | END; (* proc *) 631 | 632 | 633 | 634 | 635 | 636 | 637 | BEGIN 638 | 639 | GraphicHandle1 := GraphicsWindowCreate(ConsoleDeviceGetDefault,CONSOLE_POSITION_FULL); 640 | ActivityLEDEnable; 641 | init_texture; 642 | riscmainloop; 643 | 644 | {We're not doing a loop this time so we better halt this thread before it exits} 645 | ThreadHalt(0); 646 | END. 647 | 648 | --------------------------------------------------------------------------------