tridoracpu: cleaned up top a bit, removed some warnings

xfer: reset block count on transfer start

.gitignore

@@ -26,6 +26,7 @@ graph1.pas
 graph2.pas
 chase.pas
 pcomp/libgen
+pcomp/shortgen
 pcomp/lsymgen
 pcomp/pcomp
 pcomp/sasm
@@ -39,11 +40,12 @@ tridoraemu/tridoraemu
 *.log
 *.jou
 **/mig_dram_0/_tmp/*
+**/mig_dram_0/mig_dram_0/*
 **/mig_dram_0/doc/*
-**/mig_dram_0/mig_dram_0*
 **/mig_dram_0/xil_txt.*
 **/mig_dram_0/*.veo
 **/mig_dram_0/*.tcl
 **/mig_dram_0/*.xml
 **/mig_dram_0/*.v
 **/mig_dram_0/*.vhdl
+**/mig_dram_0/*.dcp

.gitmodules

@@ -0,0 +1,3 @@
+[submodule "rogue"]
+	path = rogue
+	url = https://gitlab.com/slederer/ecl-rogue-m.git

README.md

@@ -1,5 +1,5 @@
-# Tridora System
+# Tridora-CPU
-Tridora is a homebrew CPU written in Verilog and a matching software environment,
+The Tridora-CPU is a homebrew CPU written in Verilog and a matching software environment,
 including a Pascal compiler and assembler.
 Everything was created from the ground up (except soldering stuff).
 Everything is as simple as possible while still being reasonably useful.
@@ -8,7 +8,7 @@ Everything is open source, so you can read, understand and modify the whole syst
 ## Overview
 - homebrew CPU written in Verilog implemented on an FPGA
 - 32-bit word-oriented stack machine architecture
-- running at 83 MHz on an Arty-A7 board with four clocks per instruction
+- running at 77 MHz on an Arty-A7 board with four clocks per instruction
 - has its own instruction set architecture, compatible with nothing
 - additional IO controllers on FPGA: UART (serial console), SD-Card, VGA
 - Pascal compiler written from zero
@@ -30,13 +30,59 @@ has a strange mixture of features from three different eras of computing:
 - speed is like a fast 16-bit CPU, also 16-bit instruction words
 - 32-bit word size from the 32-bit era
 
+It might remind you of the UCSD-P-System and early Turbo-Pascal versions.
+
+Other inspirations were, among others, in no particular order:
+
+- the Novix 4016 CPU (a stack machine CPU designed for Forth, mainly by Charles Moore)
+- the J1 CPU by James Bowman (which is not entirely unlike the Novix 4016)
+- the Lilith computer by Niklaus Wirth and his team (a stack CPU designed for Modula-2)
+- the PERQ workstation (also a stack CPU designed for Pascal)
+- the Magic-1 by Bill Buzbee
+- the OPC by revaldinho
+
+## October 2025 Update
+This update introduces a data cache for the Tridora-CPU. It is similar to the instruction cache
+as it caches the 16 bytes coming from the DRAM memory controller. It is a write-back cache, i.e.
+when a word inside the cached area is written, it updates the cache instead of invalidating it.
+
+This is important because there are many idioms in the stack machine assembly language where you
+store a local variable and then read it again (e.g. updating a loop variable).
+
+Since for most programs, the user stack and parts of the heap are inside the DRAM area, the data cache
+has a more noticable impact. In the benchmark program that was already used for the last update,
+the data cache results in a 50% improvement for the empty loop test. This is in comparison to the version
+without data cache but with the instruction cache, both running code out of DRAM.
+
+It is also noticable for compile times: With the data cache, compiling and assembling the
+"hello,world" program takes 16 seconds instead of 20. With a little tweak of the SD-Card controller
+that slightly increased the data transfer rate, the build time goes down to 15 seconds.
+
+Also, an audio controller was added that allows interrupt-driven sample playback via an AMP2 PMOD.
+
+## April 2025 Update
+The clock has been reduced to 77 MHz from 83 MHz. Apparently the design was at the limit and
+timing problems were cropping up seemingly at random. Reducing the clock speed made some
+enhancements and bugfixes possible. Also, the project files work with Vivado 2024 now.
+
+Most importantly, the Tridora-CPU now has an instruction cache with a size of 16 bytes or eight instructions.
+This increases execution speed when running code out of DRAM (that is, above 64KB). In a simple
+benchmark program, the CPU is about twice as fast.
+Many programs fit into the lower 64KB of RAM, which can be accessed without latency, and will
+have no noticable speed increase.
+
+There have also been a number of bug fixes for the compiler and some for the assembler. This makes
+compiling even larger and more complex programs possible. An example of this is ECL-Rogue, a variant of Rogue written
+Pascal, which has been ported to Tridora-Pascal and is now included
+on the emulator image.
+
 ## Links/Downloads
 - the [source repository](https://gitlab.com/slederer/Tridora-CPU)
 - the [Hackaday project](https://hackaday.io/project/198324-tridora-cpu) (mostly copy-paste from this README)
 - the [YouTube channel](https://www.youtube.com/@tridoracpu/videos) with some demo videos
-- the [emulator](https://git.insignificance.de/slederer/-/packages/generic/tridoraemu/0.0.4/files/11) (source and windows binary)
+- the [emulator](https://git.insignificance.de/slederer/-/packages/generic/tridoraemu/0.0.5/files/12) (source and windows binary)
-- the [FPGA bitstream](https://git.insignificance.de/slederer/-/packages/generic/tdr-bitstream/0.0.1/files/3) for the Arty-A7-35T board
+- the [FPGA bitstream](https://git.insignificance.de/slederer/-/packages/generic/tdr-bitstream/0.0.4/files/16) for the Arty-A7-35T board
-- an [SD-card image](https://git.insignificance.de/slederer/-/packages/generic/tdr-cardimage/0.0.3/files/9)
+- an [SD-card image](https://git.insignificance.de/slederer/-/packages/generic/tdr-cardimage/0.0.4/files/13)
 
 Contact the author here: tridoracpu [at] insignificance.de
 
@@ -67,7 +113,7 @@ Two Pmods are used for a complete system:
 As the Arty-A7-35T is no longer in production, it should be easy to
 use the Arty-A7-100T instead, but this has not been tested yet.
 
-Other boards under consideration are the Digilent Nexys-A7 and the Olimex GateMateA1-EVB.
+Other boards under consideration are the Digilent Nexys-A7 and the Arty-S7.
 
 ## Pascal Language
 - Wirth Pascal
@@ -76,7 +122,7 @@ Other boards under consideration are the Digilent Nexys-A7 and the Olimex GateMa
 - safe strings (runtime information about max/current size)
 - tiny sets (machine word sized), that means no SET OF CHAR
 - array literals with IN-operator, which can replace most uses of SET OF CHAR
-- nested procedures with some limitations
+- nested procedures
 - 32 bit software floating point with low precision (5-6 digits)
 - break and exit statements, no continue yet
 - static variable initialization for global variables
@@ -107,7 +153,7 @@ Other boards under consideration are the Digilent Nexys-A7 and the Olimex GateMa
 - for **rom.mem** and **rommon.prog**, find both files in the **lib** directory after running **make nativeprogs** (or **make.bat**) in the **pcomp** directory (see above)
 
 ## Building the FPGA bitstream
-- install Vivado (known to work with 2020.1, known NOT to work with 2024.1)
+- install Vivado (April-2025-Update tested with 2024.2)
 - install the package for your board in Vivado (Tools -> Vivado Store -> Boards)
 - copy the ROM image (**rom.mem**) into the **tridoracpu** directory (see above)
 - start Vivado and open the project file **tridoracpu.xpr** in the **tridoracpu** directory
@@ -128,3 +174,8 @@ See the emulator [README](tridoraemu/README.md).
 - [The Mostly Missing Pascal Programming Guide](doc/pascalprogramming.md)
 
 More documentation is coming, as time permits.
+
+## Credits
+The Tridora-CPU uses the UART from the J1 CPU by James Bowman (*uart.v*), see https://github.com/jamesbowman/j1
+
+The VGA framebuffer uses code from Project F by Will Green, see https://projectf.io

doc/irqctrl.md

@@ -9,12 +9,13 @@ The interrupt controller uses a single register at address: $980
 
 |_bit_  |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
 |-      |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
-|_Value_|t |t |t |t |t |t |t |t |- |- |- |- |- |- |p1 |p0 |
+|_Value_|t |t |t |t |t |t |t |t |- |- |- |- |- |p2 |p1 |p0 |
 
 
 |Bitfields|Description|
 |---------|-----------|
 | _t_     | unsigned 24 bit counter of timer ticks since reset
+| _p2_    | IRQ 2 (audio) interrupt pending if 1
 | _p1_    | IRQ 1 (timer tick) interrupt pending if 1
 | _p0_    | IRQ 0 (UART) interrupt pending if 1
 

doc/mem.md

@@ -34,3 +34,4 @@ Currently, only I/O slots 0-3 are being used.
 | 1      | $880    | SPI-SD     |
 | 2      | $900    | VGA        |
 | 3      | $980    | IRQC       |
+| 4      | $A00    | TDRAUDIO   |

doc/pascalprogramming.md

@@ -103,6 +103,16 @@ Tridora-Pascal only supports the _break_ statement at the moment.
 The _exit_ statement can be used to exit the current procedure or function. If it is a function, the return value of the function is undefined if _exit_ is
 used before a return value is assigned.
 
+
+## Dynamic Memory Allocation
+Memory allocation generally works as expected with the *new* and *dispose* special procedures. The variant of *new* with two parameters that is specified in Wirth Pascal is not supported (partial allocation of a variant record). Instead, there is a variant of *new* that has a second parameter for allocating strings (see above).
+
+If heap allocation fails, *new* does not return and instead causes a runtime error. To avoid this, a different special procedure called *newOrNil* can be used. This procedure sets the pointer
+variable to *niL* if heap allocation fails.
+
+The function *MemAvail* returns the number of free bytes on the heap. It does not guarantee that this amount of memory can be allocated with *new*, because heap space can be fragmented.
+The function *MaxAvail*, which exists in some versions of Turbo Pascal and returns the size of the largest contiguous block of available heap memory, is not (yet) implemented.
+
 ## I/O
 I/O handling in Tridora Pascal is mostly compatible with other Pascal dialects when reading/writing simple variables from/to the console. There are big differences when opening/reading/writing files explicitly.
 
@@ -153,10 +163,12 @@ var f:file;
 ### Error Handling
 When an I/O error occurs, the _IOResult_ function can be called to get the error code. Unlike TP, the _IOResult_ function requires a
 file variable as a parameter. When you call _IOResult_, an error that may have occurred is considered to be _acknowledged_. If an
-error is not ackowledged and you do another I/O operation, a runtime error is thrown.
+error is not ackowledged and you do another I/O operation on that file, a runtime error is thrown.
 
 That means you can either write programs without checking for I/O errors, while resting assured that the program will exit if an I/O error occurs. You can also choose to check for errors with _IOResult_ if you want to avoid having runtime errors.
 
+If an I/O error occurs on a file, it is then considered closed. Closing a file in this state, or a file that has been closed normally, will cause a runtime error.
+
 The function _ErrorStr_ from the standard library takes an error code as an argument and returns the corresponding textual description as a string.
 
 Example:
@@ -191,7 +203,8 @@ Possible error codes from _IOResult_ are:
 | 8 | IOReadOnly        | file is readonly |  |
 | 9 | IOInvalidOp       | invalid operation |  |
 | 10 | IOInvalidFormat   | invalid format | when parsing numbers with _read_ |
-| 11 | IOUserIntr        | interrupted by user | program terminated by ^C, not visible from _IOResult_ |
+| 11 | IONoMem   | not enough memory | heap allocation failed inside the standard library, e.g. open() |
+| 12 | IOUserIntr        | interrupted by user | program terminated by ^C, not visible from _IOResult_ |
 
 ### Read, Readln and Line Input
 In Turbo Pascal, using _read_ (and _readln_) from the console always waits until a complete line has been entered.

doc/tdraudio.md

@@ -0,0 +1,104 @@
+# Audio Controller
+The audio controller provides four channels of 16-bit PCM audio playback.
+
+It uses multiple registers starting at address $A00.
+
+Each of the four channels has three registers.
+
+For the first channel the register addresses are:
+
+|Address|Description|
+|-------|-----------|
+| $A00  | Control Register |
+| $A01  | Clock Divider Register |
+| $A02  | Amplitude Register |
+
+The register addresses for the second channel start at $A04,
+the third channel at $A08
+and the fourth channel at $A0C.
+
+## Reading the control register
+
+|_bit_  |31|30|29|28|27|26|25|24|23|22|21|20|19|18|17|16|
+|-      |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
+|_Value_|- |- |- |- |- |- |- |- |- |-|- |- |- |- |- |- |
+
+|_bit_  |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
+|-      |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
+|_Value_|- |- |- |- |- |- |- |- |- |- |- |i |f | e | p | c |
+
+
+|Bitfields|Description|
+|---------|-----------|
+| _i_    | interrupt is enabled for this channel when 1 |
+| _f_    | sample buffer is full when 1 |
+| _e_    | sample buffer is empty when 1 |
+| _p_     | changes from 0 to 1 and vice versa on each sample clock |
+| _c_     | channel is enabled if 1 |
+
+## Writing the control register
+
+|_bit_  |31|30|29|28|27|26|25|24|23|22|21|20|19|18|17|16|
+|-      |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
+|_Value_|- |- |- |- |- |- |- |- |- |-|- |- |- |- |- |- |
+
+|_bit_  |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
+|-      |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
+|_Value_|- |- |- |- |- |- |- |- |- |- |- |i |- | - | - | c |
+
+
+|Bitfields|Description|
+|---------|-----------|
+| _c_     | enable channel if 1, disable if 0 |
+| _i_     | enable channel interrupt if 1, disable if 0 |
+
+
+## Writing the clock divider register
+
+|_bit_  |31|30|29|28|27|26|25|24|23|22|21|20|19|18|17|16|
+|-      |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
+|_Value_|d |d |d |d |d |d |d |d |d |d|d |d |d |d |d |d |
+
+|_bit_  |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
+|-      |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
+|_Value_|d |d |d |d |d |d |d |d |d |d|d |d |d |d |d |d |
+
+
+|Bitfields|Description|
+|---------|-----------|
+| _d_     | an unsigned 32-bit value for the clock divider |
+
+
+## Writing the amplitude register
+
+|_bit_  |31|30|29|28|27|26|25|24|23|22|21|20|19|18|17|16|
+|-      |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
+|_Value_|- |- |- |- |- |- |- |- |- |-|- |- |- |- |- |- |
+
+|_bit_  |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
+|-      |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
+|_Value_|a |a |a |a |a |a |a |a |a |a |a |a |a | a | a | a |
+
+
+|Bitfields|Description|
+|---------|-----------|
+| _a_     | an unsigned 16-bit value for the amplitude (sample) value with a bias of 32768 |
+
+## Notes
+The clock divider specifies the number of CPU clock ticks between two samples.
+
+Writing to the amplitude register adds the sample value to the sample buffer. The sample buffer is organized as a FIFO with 16 elements.
+
+Amplitude (sample) values are represented as unsigned, biased 16-bit numbers. The bias is 32768, so given an amplitude range of 1.0 to -1.0, a 1.0 is represented by 65535, 0.0 by 32768 and -1.0 by 0.
+
+Interrupt processing needs to be enabled for each channel if required.
+
+An interrupt on any channel will be signalled to the interrupt controller
+as IRQ 2. The interrupt service routine should check all running channels
+for an emtpy buffer.
+
+If an audio interrupt has occured on a channel, the interrupt enable flag
+is cleared for that channel. It needs to be re-enabled in the interrupt service routine.
+
+Interrupts also need to be enabled on the interrupt controller,
+and re-enabled there after each interrupt.

examples/LICENSES.md

@@ -7,4 +7,9 @@ https://commons.wikimedia.org/wiki/File:Ara-Zoo-Muenster-2013.jpg
 https://commons.wikimedia.org/wiki/File:Snow_leopard_portrait.jpg
 * shinkansen.pict: 投稿者が撮影, CC BY-SA 3.0 <http://creativecommons.org/licenses/by-sa/3.0/>, via Wikimedia Commons
  https://commons.wikimedia.org/wiki/File:0key22-86.JPG 
-
+* Toco_Toucan.pict: Bernard DUPONT, CC BY-SA 2.0 <https://creativecommons.org/licenses/by-sa/2.0>, via Wikimedia Commons
+https://commons.wikimedia.org/wiki/File:Toco_Toucan_(Ramphastos_toco)_-_48153967707.jpg
+* 1911_Detroit_Electric.pict: Cullen328, CC BY-SA 3.0 <https://creativecommons.org/licenses/by-sa/3.0>, via Wikimedia Commons
+https://commons.wikimedia.org/wiki/File:1911_Detroit_Electric.jpg
+* ADDS-Envoy-620.pict: ADDS Envoy-1.jpg from terminals-wiki.org, CC-BY-SA 3.0
+https://terminals-wiki.org/wiki/index.php/File:ADDS_Envoy-1.jpg

examples/animate.pas

@@ -0,0 +1,164 @@
+program animate;
+uses sprites;
+
+type PictData = record
+		magic,mode:integer;
+		palette: array [0..15] of integer;
+		pixeldata: array [0..31999] of integer;
+	end;
+
+     Sprite = record
+     	x,y:integer;
+     	oldX,oldY:integer;
+     	xdelta,ydelta:integer;
+     	curFrame:integer;
+     	frameCount:integer;
+     	frameTime:integer;
+     	frameLeft:integer;
+     	changed:boolean;
+     	frame:array [0..3] of SpritePixels;
+    end;
+
+var pic:PictData;
+    filename:string;
+    infile:file;
+    ch:char;
+    stickMan:Sprite;
+    rocket:Sprite;
+
+procedure WaitVSync; external;
+
+procedure loadPalette(var pic:PictData);
+var i:integer;
+begin
+	for i := 0 to 15 do
+		setpalette(i, pic.palette[i]);
+end;
+
+procedure showPic(var pic:PictData);
+begin
+	PutScreen(pic.pixeldata);
+end;
+
+procedure loadSpriteFrame(var aSprite:Sprite;spriteIndex:integer;
+		var sheetFile:file;sheetIndex:integer);
+begin
+	seek(sheetFile, 8 + sheetIndex * 512);
+	read(sheetFile, aSprite.frame[spriteIndex]);
+	if aSprite.frameCount <= spriteIndex then
+		aSprite.frameCount := spriteIndex + 1;
+
+	aSprite.curFrame := 0;
+	writeln('loaded sprite frame ', spriteIndex, ' from ', sheetIndex);
+end;
+
+procedure animateSprite(var aSprite:Sprite);
+var frameIndex:integer;
+    frameTime,frameLeft:integer;
+    ydelta:integer;
+    oldX,oldY:integer;
+begin
+	ydelta := aSprite.ydelta;
+	frameIndex := aSprite.curFrame;
+	frameTime := aSprite.frameTime;
+	frameLeft := aSprite.frameLeft;
+	oldX := aSprite.x; oldY := aSprite.y;
+	aSprite.oldX := oldX; aSprite.oldY := oldY;
+
+	frameLeft := frameLeft - 1;
+	if frameLeft <= 0 then
+	begin
+		frameIndex := frameIndex + 1;
+		frameLeft := aSPrite.frameTime;
+		aSprite.frameLeft := frameLeft;
+		aSprite.curFrame := frameIndex;
+		if frameIndex >= aSprite.frameCount then
+			aSprite.curFrame := 0;
+
+		aSprite.frameLeft := frameLeft;
+
+		aSprite.x := aSprite.x + aSprite.xdelta;
+		aSprite.y := aSprite.y + aSprite.ydelta;
+
+		if aSprite.x > 608 then aSprite.x := 0;
+
+		if aSprite.y < 0 then
+		begin
+			aSprite.y := 200;
+			aSprite.x := 0;
+		end;
+	end;
+	aSprite.frameLeft := frameLeft;
+end;
+
+procedure animLoop;
+var i:integer;
+    oldX,oldY:integer;
+    roldX,roldY:integer;
+begin
+	stickMan.x := 0;
+	stickMan.y := 310;
+	stickMan.frameTime := 6;
+	stickMan.frameLeft := stickMan.frameTime;
+	stickMan.curFrame := 0;
+	stickMan.xdelta := 2;
+	stickMan.ydelta := 0;
+
+
+	rocket.x := 0;
+	rocket.y := 200;
+	rocket.frameTime := 1;
+	rocket.frameLeft := rocket.frameTime;
+	rocket.curFrame := 0;
+	rocket.xdelta := 2;
+	rocket.ydelta := -1;
+
+	while not ConAvail do
+	begin
+		oldX := stickMan.x;
+		oldY := stickMan.y;
+
+		roldX := rocket.x;
+		roldY := rocket.y;
+
+		PutSprite(roldX, roldY, rocket.frame[rocket.curFrame]);
+		PutSprite(oldX, oldY, stickMan.frame[stickMan.curFrame]);
+
+		animateSprite(rocket);
+		animateSprite(stickMan);
+
+		{Delay(1);}
+		WaitVSync;
+
+		UndrawSprite(oldX, oldY, pic.pixeldata);
+		UndrawSprite(roldX, roldY, pic.pixeldata);
+	end;
+end;
+
+begin
+	filename := 'background.pict';
+	open(infile, filename, ModeReadonly);
+	read(infile, pic);
+	close(infile);
+
+	writeln('magic: ', pic.magic, ' mode:', pic.mode);
+
+	loadPalette(pic);
+	showPic(pic);
+
+	open(infile, 'walking.sprt', ModeReadOnly);
+	loadSpriteFrame(stickMan, 0, infile, 0);
+	loadSpriteFrame(stickMan, 1, infile, 1);
+	loadSpriteFrame(stickMan, 2, infile, 2);
+	loadSpriteFrame(stickMan, 3, infile, 3);
+	close(infile);
+
+	open(infile, 'rocket.sprt', ModeReadOnly);
+	loadSpriteFrame(rocket, 0, infile, 0);
+	loadSpriteFrame(rocket, 1, infile, 1);
+	loadSpriteFrame(rocket, 2, infile, 2);
+	loadSpriteFrame(rocket, 3, infile, 3);
+	close(infile);
+
+	animLoop;
+end.

examples/benchmarks.results.text

@@ -45,6 +45,7 @@ Running benchmarks.prog
                           exp() 10K 00:00:29
                           cos() 10K 00:00:06
 
+--------------------------------------
 Arty-A7-35T
 76.92MHz, 64KB SRAM, 256MB DRAM
 running in DRAM (except corelib, stdlib, runtime)
@@ -68,5 +69,128 @@ Running benchmarks.prog
                           exp() 10K 00:00:32
                           cos() 10K 00:00:06
 
-Running benchmarks.prog
+--------------------------------------
+Arty-A7-35T
+76.92MHz, 64KB SRAM, 256MB DRAM, 16B instruction cache
+running in DRAM (except corelib, stdlib, runtime)
 
+Running benchmarks.prog
+                     empty loop 10M 00:00:16
+                 write variable 10M 00:00:17
+                  read variable 10M 00:00:19
+               integer addition 10M 00:00:24
+                   real addition 1M 00:00:30
+          integer multiplication 1M 00:01:14
+             real multiplication 1M 00:01:05
+                integer division 1M 00:01:53
+                   real division 1M 00:01:13
+                 string indexing 1M 00:00:41
+                string iteration 1M 00:00:21
+                  new/dispose 1k 1M 00:00:25
+                new/dispose 128k 1M 00:00:26
+                  array copy 1k 10K 00:00:03
+                 array copy 128k 1K 00:00:48
+                          exp() 10K 00:00:32
+                          cos() 10K 00:00:06
+
+--------------------------------------
+Arty-A7-35T
+76.92MHz, 64KB SRAM, 256MB DRAM,
+  16B instruction cache, 16B wt data cache
+running in SRAM
+
+Running benchmarks.prog
+                     empty loop 10M 00:00:07
+                 write variable 10M 00:00:17
+                  read variable 10M 00:00:20
+               integer addition 10M 00:00:20
+                   real addition 1M 00:00:28
+          integer multiplication 1M 00:01:11
+             real multiplication 1M 00:00:59
+                integer division 1M 00:01:36
+                   real division 1M 00:01:05
+                 string indexing 1M 00:00:39
+                string iteration 1M 00:00:19
+                  new/dispose 1k 1M 00:00:19
+                new/dispose 128k 1M 00:00:19
+                  array copy 1k 10K 00:00:03
+                 array copy 128k 1K 00:00:39
+                          exp() 10K 00:00:26
+                          cos() 10K 00:00:05
+
+
+
+--------------------------------------
+Arty-A7-35T
+76.92MHz, 64KB SRAM, 256MB DRAM,
+  16B instruction cache, 16B wb data cache
+running in SRAM
+
+Running benchmarks.prog
+                     empty loop 10M 00:00:04
+                 write variable 10M 00:00:11
+                  read variable 10M 00:00:18
+               integer addition 10M 00:00:18
+                   real addition 1M 00:00:27
+          integer multiplication 1M 00:00:49
+             real multiplication 1M 00:00:58
+                integer division 1M 00:01:06
+                   real division 1M 00:01:04
+                 string indexing 1M 00:00:36
+                string iteration 1M 00:00:19
+                  new/dispose 1k 1M 00:00:18
+                new/dispose 128k 1M 00:00:18
+                  array copy 1k 10K 00:00:03
+                 array copy 128k 1K 00:00:39
+                          exp() 10K 00:00:25
+                          cos() 10K 00:00:05
+
+--------------------------------------
+Arty-A7-35T
+76.92MHz, 32KB SRAM, 256MB DRAM,
+  16B instruction cache, 16B wb data cache
+running in SRAM
+
+Running benchmarks.prog
+                     empty loop 10M 00:00:04
+                 write variable 10M 00:00:11
+                  read variable 10M 00:00:18
+               integer addition 10M 00:00:18
+                   real addition 1M 00:00:27
+          integer multiplication 1M 00:00:49
+             real multiplication 1M 00:00:58
+                integer division 1M 00:01:06
+                   real division 1M 00:01:04
+                 string indexing 1M 00:00:36
+                string iteration 1M 00:00:19
+                  new/dispose 1k 1M 00:00:18
+                new/dispose 128k 1M 00:00:18
+                  array copy 1k 10K 00:00:03
+                 array copy 128k 1K 00:00:39
+                          exp() 10K 00:00:25
+                          cos() 10K 00:00:05
+
+--------------------------------------------
+Arty-A7-35T
+76.92MHz, 64KB SRAM, 256MB DRAM,
+  16B instruction cache, 16B wb data cache
+running in DRAM (except corelib, stdlib, runtime)
+
+Running benchmarks.prog
+                     empty loop 10M 00:00:10
+                 write variable 10M 00:00:11
+                  read variable 10M 00:00:11
+               integer addition 10M 00:00:13
+                   real addition 1M 00:00:27
+          integer multiplication 1M 00:00:35
+             real multiplication 1M 00:00:43
+                integer division 1M 00:01:05
+                   real division 1M 00:00:51
+                 string indexing 1M 00:00:36
+                string iteration 1M 00:00:20
+                  new/dispose 1k 1M 00:00:23
+                new/dispose 128k 1M 00:00:23
+                  array copy 1k 10K 00:00:03
+                 array copy 128k 1K 00:00:48
+                          exp() 10K 00:00:28
+                          cos() 10K 00:00:04

examples/fastfire.inc

@@ -0,0 +1,5 @@
+const FIREWIDTH = 319; FIREHEIGHT = 79; (* keep in sync with fastfire.s! *)
+type FireBuf = array [0..FIREHEIGHT, 0..FIREWIDTH] of integer;
+
+procedure FastFireUpdate(var f:FireBuf); external;
+procedure FastFireDraw(var f:FireBuf;screenx, screeny:integer); external;

examples/fastfire.s

@@ -0,0 +1,326 @@
+	; width and height of the fire cell matrix
+	; Be sure to sync this with fastfire.inc!
+	.EQU FIREWIDTH 319
+	.EQU FIREHEIGHT 79
+
+	;
+	; The cell matrix actually has one column
+	; and one row more than FIREWIDTH and
+	; FIREHEIGHT to handle the negative
+	; X offsets when calculating new
+	; cell values.
+	; Likewise, there is one more row.
+	; So rows are processed from 0 to FIREHEIGHT - 2
+	; and columms from 1 to FIREWIDTH - 1.
+
+	; cells considered for calculating new
+	; value for cell O (reference cells):
+	;	.....O......
+	;	....123.....
+	;	.....4......
+
+; args: pointer to fire cell buffer
+	.EQU FF_ROW_COUNT 0
+	.EQU FF_COL_COUNT 4
+	.EQU FF_ROW_OFFS 8
+	.EQU FF_OFFS1 12
+	.EQU FF_OFFS2 16
+	.EQU FF_OFFS3 20
+	.EQU FF_OFFS4 24
+	.EQU FF_CELL_PTR 28
+	.EQU FF_FS 32
+FASTFIREUPDATE:
+	FPADJ -FF_FS
+	STORE FF_CELL_PTR
+	LOADC FIREHEIGHT-1
+	STORE FF_ROW_COUNT
+
+	; calculate offsets for reference cells
+	LOADC FIREWIDTH+1
+	SHL 2
+	DUP
+	STORE FF_ROW_OFFS	; offset to next row: WIDTH*4
+	DEC 4			; offset to cell 1: row offset - 4
+	DUP
+	STORE FF_OFFS1
+	INC 4
+	DUP
+	STORE FF_OFFS2		; offset to cell 2: + 4
+	INC 4
+	STORE FF_OFFS3		; offset to cell 3: + 4
+	LOAD FF_ROW_OFFS
+	SHL 1			; offset to cell 4: row offset * 2
+	STORE FF_OFFS4
+
+	; start at column 1
+	LOAD FF_CELL_PTR
+	INC 4
+	STORE FF_CELL_PTR
+FF_ROW:
+	LOADC FIREWIDTH-1
+	STORE FF_COL_COUNT
+	
+FF_COL:
+	LOAD FF_CELL_PTR
+	LOAD FF_OFFS1
+	ADD
+	LOADI
+
+	LOAD FF_CELL_PTR
+	LOAD FF_OFFS2
+	ADD
+	LOADI
+
+	LOAD FF_CELL_PTR
+	LOAD FF_OFFS3
+	ADD
+	LOADI
+
+	LOAD FF_CELL_PTR
+	LOAD FF_OFFS4
+	ADD
+	LOADI
+
+	ADD
+	ADD
+	ADD
+
+	SHR
+	SHR
+
+	; if new cell value > 0, subtract 1 to cool down
+	DUP
+	CBRANCH.Z FF_SKIP
+	DEC 1
+FF_SKIP:
+	LOAD FF_CELL_PTR	; load cell ptr
+	SWAP			; swap with new value
+	STOREI 4		; store with postincrement
+	STORE FF_CELL_PTR	; save new ptr value
+
+	LOAD FF_COL_COUNT	; decrement column count
+	DEC 1
+	DUP
+	STORE FF_COL_COUNT
+	CBRANCH.NZ FF_COL	; loop if col count <> 0
+
+	; at the end of a row, go to next row
+	; by adding 8 to the cell pointer,
+	; skipping the first cell of the next row
+	LOAD FF_CELL_PTR
+	INC 8
+	STORE FF_CELL_PTR
+
+	LOAD FF_ROW_COUNT	; decrement row count
+	DEC 1
+	DUP
+	STORE FF_ROW_COUNT
+	CBRANCH.NZ FF_ROW	; loop if row count <> 0
+
+FF_EXIT:
+	FPADJ FF_FS
+	RET
+
+; framebuffer controller registers
+	.EQU FB_RA $900
+	.EQU FB_WA $901
+	.EQU FB_IO $902
+	.EQU FB_PS $903
+	.EQU FB_PD $904
+	.EQU FB_CTL $905
+	.EQU WORDS_PER_LINE 80
+
+; fire width in vmem words (strict left-to-right evaluation)
+	.EQU FFD_ROW_WORDS 1 + FIREWIDTH / 8
+
+; draw all fire cells
+; args: pointer to fire cell buffer, screen x, screen y
+	.EQU FFD_CELL_PTR 0
+	.EQU FFD_X 4
+	.EQU FFD_Y 8
+	.EQU FFD_ROW_COUNT 12
+	.EQU FFD_ROW_WORDCOUNT 16
+	.EQU FFD_VMEM_PTR 20
+	.EQU FFD_FS 24
+FASTFIREDRAW:
+	FPADJ -FFD_FS
+	STORE FFD_Y
+	STORE FFD_X
+	STORE FFD_CELL_PTR
+
+	; calculate video memory addr
+	; addr = y * 80 + X / 8
+	LOAD FFD_Y
+	SHL 2	; y * 16
+	SHL 2
+	DUP
+	SHL 2	; + y * 64
+	ADD	; = y * 80
+
+	LOAD FFD_X
+	SHR
+	SHR
+	SHR
+	ADD	; + x / 8
+
+	DUP
+	STORE FFD_VMEM_PTR
+	LOADC FB_WA	; set vmem write address
+	SWAP
+	STOREI
+	DROP
+
+	LOADC FIREHEIGHT + 1
+	STORE FFD_ROW_COUNT
+FFD_ROW:
+	LOADC FFD_ROW_WORDS
+	STORE FFD_ROW_WORDCOUNT
+
+	LOADC FB_WA	; set vmem write address
+	LOAD FFD_VMEM_PTR
+	STOREI
+	DROP
+
+FFD_WORD:
+	LOAD FFD_CELL_PTR	; load cell ptr
+	LOADC 0			; vmem word, start with 0
+
+	; leftmost pixel (0)
+	OVER	;			[ cptr, vmemw, cptr ]
+	LOADI	; load cell value	[ cptr, vmemw, cellval ]
+	SHR	; scale it down (from 7 bits to 4)
+	SHR
+	SHR	;			[ cptr, vmemw, cellval shr 3 ]
+	OR	;			[ cptr, vmemw ]
+	SWAP	;			[ vmemw, cptr ] 
+	INC 4	; increment cell ptr on stack [ vmemw, cptr + 4 ]
+	SWAP	;			[ cptr + 4, vmemw ]
+
+	SHL 2			; move bits to left for next pixel
+	SHL 2
+
+	; pixel 1
+	OVER
+	LOADI	; load cell value
+	SHR	; scale it down (from 7 bits to 4)
+	SHR
+	SHR
+	OR
+	SWAP
+	INC 4	; increment cell ptr on stack
+	SWAP
+
+	SHL 2			; move bits to left for next pixel
+	SHL 2
+
+	; pixel 2
+	OVER
+	LOADI	; load cell value
+	SHR	; scale it down (from 7 bits to 4)
+	SHR
+	SHR
+	OR
+	SWAP
+	INC 4	; increment cell ptr on stack
+	SWAP
+
+	SHL 2			; move bits to left for next pixel
+	SHL 2
+
+	; pixel 3
+	OVER
+	LOADI	; load cell value
+	SHR	; scale it down (from 7 bits to 4)
+	SHR
+	SHR
+	OR
+	SWAP
+	INC 4	; increment cell ptr on stack
+	SWAP
+
+	SHL 2			; move bits to left for next pixel
+	SHL 2
+
+	; pixel 4
+	OVER
+	LOADI	; load cell value
+	SHR	; scale it down (from 7 bits to 4)
+	SHR
+	SHR
+	OR
+	SWAP
+	INC 4	; increment cell ptr on stack
+	SWAP
+
+	SHL 2			; move bits to left for next pixel
+	SHL 2
+
+	; pixel 5
+	OVER
+	LOADI	; load cell value
+	SHR	; scale it down (from 7 bits to 4)
+	SHR
+	SHR
+	OR
+	SWAP
+	INC 4	; increment cell ptr on stack
+	SWAP
+
+	SHL 2			; move bits to left for next pixel
+	SHL 2
+
+	; pixel 6
+	OVER
+	LOADI	; load cell value
+	SHR	; scale it down (from 7 bits to 4)
+	SHR
+	SHR
+	OR
+	SWAP
+	INC 4	; increment cell ptr on stack
+	SWAP
+
+	SHL 2			; move bits to left for next pixel
+	SHL 2
+
+	; pixel 7
+	OVER
+	LOADI	; load cell value
+	SHR	; scale it down (from 7 bits to 4)
+	SHR
+	SHR
+	OR
+	SWAP
+	INC 4	; increment cell ptr on stack
+	SWAP
+
+	; store word to vmem
+	; vmem write addr will autoincrement
+	LOADC FB_IO
+	SWAP
+	STOREI
+	DROP
+
+	STORE FFD_CELL_PTR
+
+	; prepare for next word
+	LOAD FFD_ROW_WORDCOUNT
+	DEC 1
+	DUP
+	STORE FFD_ROW_WORDCOUNT
+	CBRANCH.NZ FFD_WORD
+
+	; prepare for next row
+	LOAD FFD_VMEM_PTR
+	LOADC WORDS_PER_LINE
+	ADD
+	STORE FFD_VMEM_PTR	
+
+	LOAD FFD_ROW_COUNT
+	DEC 1
+	DUP
+	STORE FFD_ROW_COUNT
+	CBRANCH.NZ FFD_ROW		
+FFD_EXIT:
+	FPADJ FFD_FS
+	RET

examples/fire.pas

@@ -0,0 +1,76 @@
+{$H1}
+{$S2}
+program fire;
+const MAXX = 30;
+      MAXY = 50;
+var firebuf: array [0..MAXY, 0..MAXX] of integer;
+
+    firepalette: array [0..15] of integer =
+    	( $FFA, $FF8, $FF4, $FF0, $FE0, $FD0, $FA0, $F90,
+    	  $F00, $E00, $D00, $A00, $800, $600, $300, $000);
+    x,y:integer;
+
+procedure createPalette;
+var i:integer;
+begin
+	for i := 15 downto 0 do
+		setpalette(15 - i, firepalette[i]);
+end;
+
+procedure fireItUp;
+var x,y:integer;
+begin
+	y := MAXY - 1;
+	for x := 1 to MAXX - 1 do
+		firebuf[y, x] := random and 127;
+end;
+
+procedure updateFire;
+var i,x,y:integer;
+begin
+	for y := 0 to MAXY - 2 do
+		for x := 1 to MAXX - 1 do
+		begin
+			i :=
+				((firebuf[y + 1, x - 1]
+				+ firebuf[y + 1, x]
+				+ firebuf[y + 1, x + 1]
+				+ firebuf[y + 2, x])
+				) shr 2;
+			if i > 0 then
+				i := i - 1;
+			firebuf[y, x] := i;
+		end;
+end;
+
+procedure drawFire;
+var x, y, col:integer;
+begin
+	for y := 0 to MAXY - 1 do
+	begin
+		x := 0;
+		for col in firebuf[y] do
+		begin
+			putpixel(300 + x, 150 + y, col shr 3);
+			x := x + 1;
+		end;
+	end;
+end;
+
+begin
+	randomize;
+	initgraphics;
+	createPalette;
+	while not conavail do
+	begin
+		fireItUp;
+		updateFire;
+		drawFire;
+	end;
+
+	for y := 0 to MAXY do
+	begin
+		x := firebuf[y, 10];
+		drawline(0, y, x, y, 1);
+	end;
+end.

examples/fire2.pas

@@ -0,0 +1,84 @@
+{$H1}
+{$S1}
+program fire2;
+uses fastfire;
+
+const MAXX = FIREWIDTH;
+      MAXY = FIREHEIGHT;
+
+var firecells: FireBuf;
+
+    firepalette: array [0..15] of integer =
+    	{ ( $FFA, $FF8, $FF4, $FF0, $FE0, $FD0, $FA0, $F90,
+    	  $F00, $E00, $D00, $A00, $800, $600, $300, $000); }
+    	( $FFA, $FFA, $FFA, $FFA, $FF0, $FF0, $FF0, $FF0,
+    	  $FF0, $FD0, $FA0, $C00, $A00, $700, $400, $000);
+    x,y:integer;
+
+procedure createPalette;
+var i:integer;
+begin
+	for i := 15 downto 0 do
+		setpalette(15 - i, firepalette[i]);
+end;
+
+procedure fireItUp;
+var x,y:integer;
+begin
+	y := MAXY - 1;
+	for x := 1 to MAXX - 1 do
+		firecells[y, x] := random and 127;
+end;
+
+
+procedure updateFire;
+var i,x,y:integer;
+begin
+	for y := 0 to MAXY - 2 do
+		for x := 1 to MAXX - 1 do
+		begin
+			i :=
+				((firecells[y + 1, x - 1]
+				+ firecells[y + 1, x]
+				+ firecells[y + 1, x + 1]
+				+ firecells[y + 2, x])
+				) shr 2;
+			if i > 0 then
+				i := i - 1;
+			firecells[y, x] := i;
+		end;
+end;
+
+procedure drawFire;
+var x, y, col:integer;
+begin
+	for y := 0 to MAXY - 1 do
+	begin
+		x := 0;
+		for col in firecells[y] do
+		begin
+			putpixel(100 + x, 150 + y, col shr 3);
+			x := x + 1;
+		end;
+	end;
+end;
+
+begin
+	randomize;
+	initgraphics;
+	createPalette;
+	while not conavail do
+	begin
+		fireItUp;
+		FastFireUpdate(firecells);
+		{ updateFire; }
+		FastFireDraw(firecells, 160, 100);
+		{ drawFire; }
+	end;
+
+	for y := 0 to MAXY do
+	begin
+		x := firecells[y, 10];
+		drawline(0, y, x, y, 1);
+	end;
+end.

examples/pcmtest.pas

@@ -0,0 +1,47 @@
+{$H1536}
+program pcmtest;
+uses pcmaudio;
+
+var filename:string;
+    buf:SndBufPtr;
+    f:file;
+    size:integer;
+    i:integer;
+    c:char;
+    sampleRate:integer;
+    err:integer;
+begin
+	if ParamCount > 0 then
+		filename := ParamStr(1)
+	else
+	begin
+		write('Filename> ');
+		readln(filename);
+	end;
+
+	err := 1;
+	if ParamCount > 1 then
+		val(ParamStr(2),sampleRate, err);
+
+	if err <> 0 then
+		sampleRate := 16000;
+
+	open(f, filename, ModeReadOnly);
+	size := FileSize(f);
+	new(buf, size);
+
+	buf^ := '';
+	write('Reading ', size, ' bytes...');
+	for i := 1 to size do
+	begin
+		read(f,c);
+		AppendChar(buf^,c);
+	end;
+	writeln;
+
+	close(f);
+
+	PlaySample(buf, sampleRate);
+
+	dispose(buf);
+end.

examples/pcmtest2.pas

@@ -0,0 +1,74 @@
+{$H2560}
+program pcmtest2;
+uses pcmaudio;
+
+var filename:string;
+    buf:SndBufPtr;
+    sampleRate:integer;
+    err:integer;
+    done:boolean;
+    c:char;
+
+function readAudioFile(fname:string):SndBufPtr;
+var i,size:integer;
+    c:char;
+    buf:SndBufPtr;
+    f:file;
+begin
+	open(f, fname, ModeReadOnly);
+	size := FileSize(f);
+	new(buf, size);
+
+	buf^ := '';
+	write('Reading ', size, ' bytes...');
+	for i := 1 to size do
+	begin
+		read(f,c);
+		AppendChar(buf^,c);
+	end;
+	writeln;
+
+	close(f);
+
+	readAudioFile := buf;
+end;
+
+begin
+	if ParamCount > 0 then
+		filename := ParamStr(1)
+	else
+	begin
+		write('Filename> ');
+		readln(filename);
+	end;
+
+	err := 1;
+	if ParamCount > 1 then
+		val(ParamStr(2), sampleRate, err);
+	if err > 0 then
+		sampleRate := 32000;
+
+	buf := readAudioFile(filename);
+
+	SampleQStart(buf, sampleRate);
+
+	write('Press ESC to stop> ');
+	done := false;
+	while not done do
+	begin
+		read(c);
+		if c = #27 then
+		begin
+			done := true; writeln(';');
+		end
+		else
+		if c = '?' then
+		begin
+			writeln; writeln('Queue: ', SampleQSize);
+		end;
+	end;
+
+	SampleQStop;
+
+	dispose(buf);
+end.

examples/pictviewer.pas

@@ -40,6 +40,4 @@ begin
 
 	loadPalette(pic);
 	loadPic(pic);
-	write('Press any key...');
-	read(ch);
 end.

examples/sprites.inc

@@ -1,4 +1,4 @@
-type SpritePixels = array[0..31] of integer;
+type SpritePixels = array[0..128] of integer;
 type BackgroundPixels = array[0..31999] of integer;
 
 procedure PutSprite(x,y:integer; var sprite: SpritePixels); external;

examples/sprites.s

@@ -1,4 +1,5 @@
-	.EQU SPRITE_HEIGHT 16
+	.EQU SPRITE_HEIGHT 32	; height in lines
+	.EQU SPRITE_STRIPES 4	; width in words i.e. 8-pixel stripes
 
         .EQU WORDS_PER_LINE 80
         .EQU FB_RA      $900
@@ -65,7 +66,8 @@ CALC_VMEM_ADDR:
 	.EQU PS_Y		16
 	.EQU PS_SHIFT_C		20
 	.EQU PS_SPILL		24
-	.EQU PS_FS 28
+	.EQU PS_STRIPE_C	28
+	.EQU PS_FS 32
 PUTSPRITE:
 	FPADJ -PS_FS
 	STORE PS_SPRITE_DATA
@@ -160,10 +162,14 @@ PS_LOOP2_X:
 	STOREI			; store result into i/o reg
 	DROP
 
-	;
+	; set counter for remaining stripes
-	; process spilled bits and right half of sprite data
+	LOADC SPRITE_STRIPES - 1
-	;
+	STORE PS_STRIPE_C
 
+	;
+	; process spilled bits and next vertical stripe of sprite data
+	;
+PS_NEXT_STRIPE:
 	; put spill bits on stack for later
 	LOAD PS_SPILL
 
@@ -176,7 +182,9 @@ PS_LOOP2_X:
 	; reset spill bits
 	LOADC 0
 	STORE PS_SPILL
-	
+
+	; last spill bits are on ToS now
+
 	; shift pixel data to right
 	LOAD PS_SHIFT_C		; load shift count
 PS_LOOP3:			; test it for zero
@@ -230,8 +238,14 @@ PS_LOOP3_X:
 	SWAP
 	STOREI
 	DROP
-	
+
-	; write spilled bits into next vmem word
+	LOAD PS_STRIPE_C	; decrement stripe count
+	DEC 1
+	DUP
+	STORE PS_STRIPE_C
+	CBRANCH.NZ PS_NEXT_STRIPE ; if non-zero, next stripe
+
+	; write spilled bits of the last stripe into next vmem word
 	LOAD PS_SPILL		; get spill bits
 	DUP
 	LOADCP CALC_MASK	; calculate sprite mask for spill bits
@@ -274,7 +288,8 @@ PS_L_XT:
 	.EQU UD_S_BGDATA 12
 	.EQU UD_S_OFFSET 16
 	.EQU UD_S_BGORIG 20
-	.EQU UD_S_FS 24
+	.EQU UD_STRIPE_C 24
+	.EQU UD_S_FS 28
 UNDRAWSPRITE:
 	FPADJ -UD_S_FS
 	STORE UD_S_BGORIG
@@ -318,25 +333,35 @@ UD_S_L1:
 	STOREI
 	; reuse addr from STOREI
 
-	; load 2nd word of background data	
+	LOADC SPRITE_STRIPES - 1 ; set remaining stripe count
+	STORE UD_STRIPE_C
+
+UD_NEXT_STRIPE:
+	; load next word of background data	
 	LOAD UD_S_BGDATA
 	INC 4
 	DUP
 	STORE UD_S_BGDATA
 	LOADI
 	STOREI ; and write it to vmem
-	DROP
+	; reuse addr from STOREI
 
-	; if pixel shift is zero, no 3rd word
+	LOAD UD_STRIPE_C	; decrease remaining stripe count
+	DEC 1
+	DUP
+	STORE UD_STRIPE_C
+	CBRANCH.NZ UD_NEXT_STRIPE ; if non-zero, next stripe
+
+	DROP ; remove addr from STOREI
+
+	; if pixel shift is zero, no spill word
 	LOAD UD_S_PXS
 	CBRANCH.Z UD_S_L2
 
-	; load 3rd word of background data
+	; load next word of background data
 	LOADCP FB_IO
 	LOAD UD_S_BGDATA
 	INC 4
-	DUP
-	STORE UD_S_BGDATA
 	LOADI
 	STOREI ; and write it to vmem
 	DROP

examples/xmas.pas

@@ -1,3 +1,7 @@
+(* This program does not work anymore, because
+   it uses the old sprite routines with 16x16 sprites.
+   It is only included for historical reasons.
+   *)
 program XmasAnimation;
 uses sprites;
 

lib/corelib.s

@@ -612,6 +612,9 @@ WAIT1LOOP:
 ; length must be multiple of wordsize.
 ; if it is not, the last (partial) word is not cleared.
 _CLEARMEM:
+	OVER	; check for null pointer
+	CBRANCH.Z CLEARMEM_X
+
 	SHR
 	SHR	; calculate length in words
 

lib/pcmaudio.inc

@@ -0,0 +1,7 @@
+type SndBuf = string[32768];
+type SndBufPtr = ^SndBuf;
+
+procedure PlaySample(buf:SndBufPtr;sampleRate:integer); external;
+procedure SampleQStart(buf:SndBufPtr;sampleRate:integer); external;
+procedure SampleQStop; external;
+function SampleQSize:integer; external;

lib/pcmaudio.s

@@ -0,0 +1,247 @@
+	.EQU AUDIO_BASE $A00
+	.EQU IRQC_REG $980
+	.EQU IRQC_EN $80
+
+; args: sample rate
+START_PCMAUDIO:
+	; calculate clock divider
+	LOADCP 77000000
+	SWAP
+	LOADCP _DIV
+	CALL
+
+	LOADC AUDIO_BASE + 1
+	SWAP		; put clock divider on ToS
+;	LOADCP 4812	; clock divider for 16KHz sample rate
+;	LOADCP 2406	; clock divider for 32KHz sample rate
+	STOREI 1
+	LOADCP 32768	; set amplitude to biased 0
+	STOREI
+	DROP
+	LOADC AUDIO_BASE
+	LOADC 17	; enable channel, enable interrupt
+	STOREI
+	DROP
+	RET
+
+STOP_AUDIO:
+	LOADC AUDIO_BASE
+	LOADC 0
+	STOREI
+	DROP
+	RET
+
+; args: pointer to pascal string, sample rate
+	.EQU PS_PTR 0
+	.EQU PS_COUNT 4
+	.EQU PS_FS 12
+PLAYSAMPLE:
+	FPADJ -PS_FS
+
+	LOADCP START_PCMAUDIO
+	CALL
+
+	DUP
+	LOADI		; get string size from header
+	SHR		; divide by 4 to get word count
+	SHR
+
+	STORE PS_COUNT
+	INC 8		; skip rest of header
+	STORE PS_PTR	; store sample data pointer
+
+PS_L0:
+	LOAD PS_PTR	; load pointer
+	INC.S1.X2Y 4	; increment and keep old value
+	STORE PS_PTR	; store incremented value
+
+	LOADI		; load 32 bit word
+	DUP
+	BROT		; get upper 16 bit word
+	BROT
+	LOADCP $FFFF
+	AND
+
+	LOADCP PLAY_1SAMPLE
+	CALL
+
+	LOADCP $FFFF	; get lower 16 bit word
+	AND
+	LOADCP PLAY_1SAMPLE
+	CALL
+
+	LOAD PS_COUNT	; load word count
+	DEC 1		; decrement
+	DUP
+	STORE PS_COUNT
+	CBRANCH.NZ PS_L0 ; loop if not zero
+
+	LOADCP STOP_AUDIO
+	CALL
+
+	FPADJ PS_FS
+	RET
+
+; play one sample, waiting
+; for the clock divider, which
+; is visible via the phase flag
+; args: 16-bit unsigned sample
+PLAY_1SAMPLE:
+
+PLAY1_L0:
+	LOADC AUDIO_BASE
+	LOADI
+	LOADC 8		; get fifo_full flag
+	AND
+	CBRANCH.NZ PLAY1_L0 ; loop if fifo is full
+
+	LOADC AUDIO_BASE+2 ; store amplitude value
+	SWAP
+	STOREI
+	DROP
+	RET
+
+; start interrupt-driven sample playback
+; args: pointer to pascal string, sample rate
+SAMPLEQSTART:
+	LOADCP START_PCMAUDIO
+	CALL
+
+	LOADCP SMPLQ_COUNT
+	OVER
+	LOADI		; get string size from header
+	SHR		; divide by 4 to get word count
+	SHR
+
+	STOREI
+	DROP
+
+	LOADCP SMPLQ_PTR
+	SWAP
+	INC 8		; skip rest of header
+	STOREI		; store sample data pointer
+	DROP
+
+	LOADCP SMPLQ_ISR ; set interrupt handler
+	STOREREG IV
+
+	LOADC IRQC_REG	; enable irq
+	LOADC IRQC_EN
+	STOREI
+	DROP
+
+	RET
+
+SAMPLEQSTOP:
+	LOADCP SMPLQ_PTR
+	LOADC 0
+	STOREI
+	DROP
+
+	LOADCP STOP_AUDIO
+	CALL
+
+	LOADC IRQC_REG	; disable irq
+	LOADC 0
+	STOREI
+	DROP
+	RET
+
+SAMPLEQSIZE:
+	LOADCP SMPLQ_COUNT
+	LOADI
+	RET
+
+SMPLQ_PTR: .WORD 0
+SMPLQ_COUNT: .WORD 0
+
+SMPLQ_ISR:
+	LOADC IRQC_REG
+	LOADI
+	LOADC 4	; check for audio interrupt
+	AND
+	CBRANCH.Z SMPLQ_I_XT ; if flag not set, exit
+
+SMPLQ_I_L:
+	LOADCP SMPLQ_PTR
+	LOADI			; load word pointer
+	DUP
+	CBRANCH.NZ SMPLQ_I_B	; check for null pointer
+	DROP
+	BRANCH SMPLQ_I_XT	; if null, end interrupt routine
+SMPLQ_I_B:
+	LOADI	; load next word
+	DUP
+
+	BROT	; get high half-word
+	BROT
+	LOADCP $FFFF
+	AND
+
+	LOADC AUDIO_BASE+2
+	SWAP
+	STOREI	; write sample, keep addr
+
+	SWAP	; addr to NoS, lower halfword on ToS
+	LOADCP $FFFF
+	AND
+	STOREI	; write sample
+	DROP
+
+	; decrement word count
+	LOADCP SMPLQ_COUNT
+	LOADI.S1.X2Y		; load counter, keep addr
+	DEC 1
+	DUP
+	CBRANCH.Z SMPLQ_I_END	; end if zero
+
+	STOREI			; store new counter value
+	DROP
+
+	; increment pointer
+	LOADCP SMPLQ_PTR
+	LOADI.S1.X2Y
+	INC 4
+	STOREI
+	DROP
+
+	; check if fifo is full
+	LOADC AUDIO_BASE
+	LOADI
+	LOADC 8	; fifo_full
+	AND
+	CBRANCH.Z SMPLQ_I_L ; next sample if not full
+
+	LOADC AUDIO_BASE
+	LOADC 17	; re-enable channel interrupt
+	STOREI
+	DROP
+
+	BRANCH SMPLQ_I_XT
+
+	; end playback, set ptr and counter to zero
+SMPLQ_I_END:
+	DROP
+	DROP
+	LOADCP SMPLQ_PTR
+	LOADC 0
+	STOREI
+	DROP
+	LOADCP SMPLQ_COUNT
+	LOADC 0
+	STOREI
+	DROP
+
+	; set amplitude out to zero (biased)
+	LOADC AUDIO_BASE+2
+	LOADCP 32768
+	STOREI
+	DROP
+
+SMPLQ_I_XT:
+	LOADC IRQC_REG		; re-enable interrupts
+	LOADC IRQC_EN
+	STOREI
+	DROP
+	LOADREG IR		; jump via interrupt return register
+	JUMP

lib/runtime.s

@@ -1616,7 +1616,7 @@ MEM_FREE_XT:
 ; Since the return stack is no longer valid afterwards, directly
 ; jumps to _MAIN instead of using RET.
 
-; parameters: [ _MAIN entry point, start of heap address ]
+; parameters: [ start of heap address ]
 _MEM_INIT:
 	; initialize anchor chunk with start of heap address
 	; and heap size - header size
@@ -1764,6 +1764,34 @@ MEM_DUMP_L0:
 	DROP
 	RET
 
+; calculate total free heap space
+; args: none
+; returns: cumulative size of all free chunks in bytes
+MEMAVAIL:
+	FPADJ -4
+	LOADC 0
+	STORE 0	; start with zero as result
+
+	LOADCP _HEAP_ANCHOR
+MAV_L:
+	DUP	; dup chunk ptr for later
+	INC 4	; move to size field
+	LOADI	; load chunk size
+	LOAD 0  ; add to current result value
+	ADD
+	STORE 0
+
+	LOADI	; load next ptr
+	DUP
+	LOADCP _HEAP_ANCHOR ; compare with anchor
+	CMPU NE
+	CBRANCH MAV_L       ; if not equal, loop
+MAX_XT:
+	DROP	; drop chunk ptr
+	LOAD 0	; put result value on stack
+	FPADJ 4
+	RET
+
 ; check if a pointer is part of the free list
 ; args: pointer returned by MEM_ALLOC
 ; throws runtime error if the pointer is found
@@ -1903,6 +1931,12 @@ _CLEARESTACK_XT:
 ; Terminate program: clear estack and
 ; jump to coreloader
 PTERM:
+	; just to be safe, disable interrupts
+	LOADC $980
+	LOADC 0
+	STOREI
+	DROP
+
 	LOADCP _CLEARESTACK
 	CALL
 	LOADCP LOADER_START

lib/sdcardlib.s

@@ -264,8 +264,8 @@ CARD_OK:
 ; set fast transfer rate
 CARDFASTCLK:
 	LOADC SPIREG
-	; set clock divider to ~2,6MHz
+	; set clock divider to ~2.75MHz
-	LOADCP SPI_CLK_DIV_WR,10 ; using the LOADCP with offset syntax here
+	LOADCP SPI_CLK_DIV_WR,7 ; using the LOADCP with offset syntax here
 	STOREI
 	DROP
 	RET

lib/stdlib.inc

@@ -18,8 +18,9 @@ const IONoError 	=  0;
       IOReadOnly 	=  8;
       IOInvalidOp	=  9;
       IOInvalidFormat   = 10;
-      IOUserIntr	= 11;
+      IONoMem		= 11;
-      IOMaxErr          = 11;
+      IOUserIntr	= 12;
+      IOMaxErr          = 12;
 
 const PArgMax = 7;
 
@@ -148,6 +149,7 @@ procedure appendchar(var s:string; aChar:char); external;
 procedure strmoveup(var s:string;index,length,delta:integer); external;
 procedure strmovedown(var s:string;index,length,delta:integer); external;
 procedure RuntimeError(var s:string); external;
+function MemAvail:integer; external;
 
 (* from stdlib *)
 function copy(s:string[256];index,count:integer):string[256]; external;
@@ -205,7 +207,7 @@ procedure readvolumeblks(volumeid:integer; destbuf:^iobuffer; blkno:integer; blk
 procedure writevolumeblks(volumeid:integer; srcbuf:^iobuffer; blkno:integer; blkCount: integer; var error:integer);
 	external;
 function findvolume(name:string):integer; external;
-procedure openvolumeid(volid:integer); external;
+procedure openvolumeid(volid:integer;var error:integer); external;
 procedure closevolumeid(volid:integer); external;
 function IOResult(var fil:file):integer; external;
 function ErrorStr(err:integer):string; external;

lib/stdlib.pas

@@ -26,8 +26,9 @@ const IONoError 	=  0;
       IOReadOnly 	=  8;
       IOInvalidOp	=  9;
       IOInvalidFormat   = 10;
-      IOUserIntr	= 11;
+      IONoMem		= 11;
-      IOMaxErr          = 11;
+      IOUserIntr	= 12;
+      IOMaxErr          = 12;
 
 const PArgMax = 7;
 
@@ -133,7 +134,7 @@ var DefaultVolumeId:integer;
 		character to the runtime error routine
 		which takes null-terminated strings.
 	*)
-var ioerrordesc: array [0..11] of string[20] = (
+var ioerrordesc: array [0..IOMaxErr] of string[20] = (
 	'No error',
         'File not found',
 	'Volume not found',
@@ -145,6 +146,7 @@ var ioerrordesc: array [0..11] of string[20] = (
 	'File is readonly',
 	'Invalid operation',
 	'Invalid format',
+	'Not enough memory',
 	'Interrupted by user'
 	);
 
@@ -1183,7 +1185,17 @@ ext:
 		code := 0;
 	end
 	else
-		code := i - 1;
+	begin
+		if i = 1 then  (* empty string gives error position 1 *)
+			code := 1
+		else
+			code := i - 1;
+	end;
+end;
+
+procedure errorhalt(var fil:file);
+begin
+	RuntimeError(ioerrordesc[fil.lastError]);
 end;
 
 procedure checkerror(var fil:file);
@@ -1191,7 +1203,7 @@ begin
 	if fil.lastError <> 0 then
 	begin
 		if not fil.errorAck then
-			RuntimeError(ioerrordesc[fil.lastError])
+			errorhalt(fil)
 		else
 		begin
 			fil.lastError := 0;
@@ -1334,12 +1346,16 @@ procedure freadreal(var v:real;var f:file);
 var buf:string[40];
     errpos:integer;
 begin
+	errpos := -1;
 	fskipwhite(f);
 	fscanbuf(f,ScanReal, buf);
 	if f.lastError = 0 then
 		val(buf, v, errpos);
 	if errpos <> 0 then
+	begin
 		fileerror(f, IOInvalidFormat);
+		checkerror(f);
+	end;
 end;
 
 procedure freadstring(var s:string; var f:file);
@@ -1352,7 +1368,7 @@ var aChar:char;
 begin
 	repeat
 		aChar := freadchar(aFile);
-	until (aChar = #13) or eof(aFile);
+	until eoln(aFile); (* eoln checks for cr, lf and eof *)
 
 	(*
 		If it is a disk file, try to read the
@@ -1540,13 +1556,17 @@ begin
 	end;
 end;
 
-procedure openvolumeid(volid:integer);
+procedure openvolumeid(volid:integer;var error:integer);
 begin
+	error := 0;
 	with volumeTable[volid] do
 	begin
 		if dirCache = nil then
-			new(dirCache);
+			newOrNil(dirCache);
-		openFilesCount := openFilesCount + 1;
+		if dirCache <> nil then
+			openFilesCount := openFilesCount + 1
+		else
+			error := IONoMem;
 	end;
 end;
 
@@ -1665,12 +1685,21 @@ begin
 	{ writeln('  readbuf data: ', fil.buffer^[0][0]); }
 end;
 
+procedure close(var aFile:file); forward;
+
+(* Set error state on file and close it.
+   Buffer will not be flushed as that might
+   have caused the error.
+*)
 procedure fileerror(var fil:file; error:integer);
 begin
-	(* should check if there was an error already
-	   and throw a runtime error in that case *)
 	fil.lastError := error;
 	fil.errorAck := false;
+	if fil.buffer <> nil then
+	begin
+		fil.needsflush := false;
+		close(fil);
+	end;
 end;
 
 function IOResult(var fil:file):integer;
@@ -1815,6 +1844,8 @@ end;
 
 function filesize(var fil:file):integer;
 begin
+	checkerror(fil);
+
 	if fil.typ = IOChannel then
 		filesize := -1
 	else
@@ -2013,23 +2044,28 @@ begin
 
 	aFile.typ := IODiskFile;
 	aFile.mode := mode;
-	new(aFile.buffer);
+	newOrNil(aFile.buffer);
-	aFile.bufpos := 0;
+	if aFile.buffer = nil then
-	aFile.bufsize := DefaultBufSize;
+		fileerror(aFile, IONoMem)
-	aFile.needsflush := false;
+	else
-	aFile.changed := false;
+	begin
-	aFile.lastError := 0;
+		aFile.bufpos := 0;
-	aFile.errorAck := false;
+		aFile.bufsize := DefaultBufSize;
-	aFile.volumeid := volid;
+		aFile.needsflush := false;
-	aFile.fileno := slotno;
+		aFile.changed := false;
-	aFile.filpos := 0;
+		aFile.lastError := 0;
-	aFile.bufStart := 1;
+		aFile.errorAck := false;
-	aFile.size := dirslot.sizeBytes;
+		aFile.volumeid := volid;
-	aFile.sizeExtents := dirslot.sizeBytes div extentSize + 1;
+		aFile.fileno := slotno;
-	aFile.bufBlocks := DefaultBufBlocks;
+		aFile.filpos := 0;
-	aFile.extentBlocks := extentSize div 512;
+		aFile.bufStart := 1;
+		aFile.size := dirslot.sizeBytes;
+		aFile.sizeExtents := dirslot.sizeBytes div extentSize + 1;
+		aFile.bufBlocks := DefaultBufBlocks;
+		aFile.extentBlocks := extentSize div 512;
 
-	seek(aFile,0);
+		seek(aFile,0);
+	end;
 end;
 
 procedure updatedirslot(var aFile:file);
@@ -2052,19 +2088,22 @@ procedure close(var aFile:file);
 begin
 	if aFile.typ = IODiskFile then
 	begin
+		if aFile.lastError = IOFileClosed then
+			errorhalt(aFile);
 		{ writeln('close needsflush:', aFile.needsflush, ' changed:', aFile.changed, ' error:', aFile.lastError); }
 		if aFile.needsflush then
 			flushfile(aFile);
+
+		{ writeln('close f.buffer:', aFile.buffer); }
+		dispose(aFile.buffer);
+		aFile.buffer := nil;
+
 		if aFile.lastError = 0 then
 		begin
-			fileerror(aFile, IOFileClosed);
-			{ writeln('close f.buffer:', aFile.buffer); }
-			dispose(aFile.buffer);
-			aFile.buffer := nil;
-
 			if aFile.changed then
 				updatedirslot(aFile);
-
+			if aFile.lastError = 0 then
+				fileerror(aFile, IOFileClosed);
 		end;
 
 		closevolumeid(aFile.volumeid);
@@ -2243,8 +2282,9 @@ begin
 
 	if volid > 0 then
 	begin
-		openvolumeid(volid);
+		openvolumeid(volid, error);
-		slotno := findfile(volid, fname, dirs, error)
+		if error = 0 then
+			slotno := findfile(volid, fname, dirs, error)
 	end
 	else
 		error := IOVolNotFound;

pcomp/Makefile

@@ -1,15 +1,19 @@
 PCOMP=./pcomp
 SASM=./sasm
 LSYMGEN=./lsymgen
-LIBGEN=./libgen
 
 .SUFFIXES:
-.SUFFIXES: .pas .o
+.SUFFIXES: .pas .o .s .prog
+
+.pas.s:
+	$(PCOMP) $<
+.s.prog:
+	$(SASM) $<
 
 .pas:
 	fpc -Mobjfpc -gl $<
 
-all: pcomp sasm sdis lsymgen shortgen
+all: pcomp sasm sdis lsymgen shortgen nativeprogs
 
 libs: pcomp sasm lsymgen shortgen
 	$(SASM) ../lib/coreloader.s
@@ -18,29 +22,23 @@ libs: pcomp sasm lsymgen shortgen
 	$(SASM) ../lib/stdlibwrap.s ../lib/stdlib.lib
 	$(LSYMGEN) ../lib/stdlibwrap.sym ../lib/stdlib.lsym
 
-nativecomp: pcomp sasm libs
+test: sasm.s pcomp.s lsymgen.s shortgen.s
-	$(PCOMP) sasm.pas
-	$(PCOMP) pcomp.pas
-	$(PCOMP) lsymgen.pas
-	$(PCOMP) libgen.pas
 
-nativeprogs: nativecomp
+testprgs: sasm.prog pcomp.prog lsymgen.prog shortgen.prog
-	$(PCOMP) ../progs/shell.pas
+
-	$(PCOMP) ../progs/editor.pas
+nativecomp: libs pcomp.prog sasm.prog lsymgen.prog shortgen.prog
-	$(PCOMP) ../progs/reclaim.pas
+
-	$(PCOMP) ../progs/dumpdir.pas
+nativeprogs: pcomp ../progs/shell.prog ../progs/editor.prog ../progs/reclaim.prog \
-	$(PCOMP) ../progs/partmgr.pas
+        ../progs/dumpdir.prog ../progs/partmgr.prog ../progs/xfer.prog \
-	$(PCOMP) ../progs/xfer.pas
+        ../progs/recover.prog ../progs/changemem.prog
 	$(SASM) ../lib/rommon.s
 	$(SASM) -A ../lib/rommon.s ../lib/rom.mem
-examples: nativecomp
+
-	$(PCOMP) ../tests/readtest.pas
+examples: nativecomp ../tests/readtest.prog ../tests/readchartest.prog ../tests/timetest.prog \
-	$(PCOMP) ../tests/readchartest.pas
+	../tests/test133.prog ../tests/cchangetest.prog ../tests/tree.prog
-	$(PCOMP) ../tests/timetest.pas
-	$(PCOMP) ../tests/test133.pas
 	-$(PCOMP) ../examples/chase.pas
-	$(PCOMP) ../tests/cchangetest.pas
+	-$(SASM) ../examples/chase.s
-	$(PCOMP) ../tests/tree.pas
+	-$(MAKE) -C ../rogue -f Makefile.tridoracpu
-	
+
 clean:
-	rm -f pcomp sasm sdis libgen lsymgen *.o *.s
+	rm -f pcomp sasm sdis libgen lsymgen *.o *.s *.prog

pcomp/emit.pas

@@ -111,7 +111,7 @@ begin
 	emitIns2('BRANCH','@+2');	(* NOP, to make alignment explicit *)
 	emitIns('.CPOOL');			(* header/prologue + 2 constants is 32 bytes *)
 
-	if useStdlib then
+	if useStdlib and not useStandalone then
 	begin
 		writeln(outfile, '%include "stdlib.lsym"');
 		writeln(outfile, '%incbin "stdlib.lib"');
@@ -312,14 +312,21 @@ begin
 	emitArrayConsts;
 
 	if useStandalone then
-		emitInclude('corelib.s')
+	begin
+		emitInclude('corelib.s');
+		emitInclude('runtime.s');
+		emitInclude('float32.s');
+		emitInclude('stdlib.s');
+	end
 	else
 		emitInclude('coreloader.lsym');
 
 	rewindStringList(usedUnits);
 	while nextStringListItem(usedUnits, unitName) do
 		emitInclude(unitName + UnitSuffix2);
-
+	(* _END label needs to be word-aligned because
+		it is used as the start of the heap *)
+	emitIns('.ALIGN');
 	emitLabelRaw('_END');
 end;
 
@@ -1059,6 +1066,7 @@ end;
    *)
 procedure emitProcedureCall(aProc: ProcRef);
 var procLabel: IdentString;
+	i:integer;
 begin
 	(* pass pointer to stackframe of caller for nested procedures *)
 	if aProc^.isNested then
@@ -1069,9 +1077,17 @@ begin
 		if aProc^.level > curProcedure^.level then
 			emitIns2('LOADREG','FP')
 		else
-			(* TODO: calling nested aProc with a lower nesting level.
+		begin
-				need to chase a chain of old BP pointers. *)
+			(*  Calling nested aProc with a lower nesting level.
-			errorExit2('internal error: outward call of nested aProc not implemented', '');
+				Need to chase a chain of old BP pointers. *)
+			emitIns2('LOADREG', 'BP');
+			(*	BP points to the stackframe of the outer procedure,
+				@BP contains the stackframe of the procedure one step further
+					outwards, and so on.
+			*)
+			for i := aProc^.level + 1 to curProcedure^.level do
+				emitIns('LOADI');
+		end;
 	end;
 
 	emitFpAdjust(-curProcedure^.tempsSize);
@@ -1250,7 +1266,7 @@ begin
 		(* nothing to do *)
 	end
 	else
-	if amount <= MaxTinyOffset then
+	if (amount > 0) and (amount <= MaxTinyOffset) then
 		emitIns2Int('INC', amount)
 	else
 	begin
@@ -1266,7 +1282,7 @@ begin
 		(* nothing to do *)
 	end
 	else
-	if amount <= MaxTinyOffset then
+	if (amount > 0) and (amount <= MaxTinyOffset) then
 		emitIns2Int('DEC', amount)
 	else
 	begin

pcomp/make.bat

@@ -27,6 +27,8 @@ py pcomp.py ..\progs\reclaim.pas
 py pcomp.py ..\progs\dumpdir.pas
 py pcomp.py ..\progs\partmgr.pas
 py pcomp.py ..\progs\xfer.pas
+py pcomp.py ..\progs\recover.pas
+py pcomp.py ..\progs\changemem.pas
 sasm ..\lib\rommon.s
 sasm -A ..\lib\rommon.s ..\lib\rom.mem
 
@@ -39,3 +41,11 @@ py pcomp.py ..\tests\test133.pas
 py pcomp.py ..\examples\chase.pas
 py pcomp.py ..\tests\cchangetest.pas
 py pcomp.py ..\tests\tree.pas
+
+if not exist ..\rogue\rogue.pas exit /b
+
+cd ..\rogue
+..\pcomp\pcomp rogue.pas
+..\pcomp\sasm rogue.s
+
+cd ..\pcomp

pcomp/pcomp.pas

@@ -43,7 +43,7 @@ type 	TokenType = (
 		ArrayType, RecordType, PointerType, StringCharType, EnumType, 
 		SetType, UnresolvedType );
 
-	SpecialProc = ( NoSP, NewSP, DisposeSP, ReadSP, WriteSP, ReadlnSP, WritelnSP,
+	SpecialProc = ( NoSP, NewSP, New0SP, DisposeSP, ReadSP, WriteSP, ReadlnSP, WritelnSP,
 			SetlengthSP, ValSP, StrSP, ExitSP );
 	SpecialFunc = ( NoSF, TruncSF, FracSF, IntSF, SqrSF, SuccSF, PredSF,
 			OddSF, ChrSF, OrdSF, AbsSF);
@@ -291,7 +291,7 @@ var
 		'UNIT', 'IMPLEMENTATION', 'INTERFACE', 'USES',
 		'_' );
 		specialprocnames: array [SpecialProc] of string[12] = (
-			'_', 'NEW', 'DISPOSE', 'READ', 'WRITE', 'READLN', 'WRITELN', 'SETLENGTH',
+			'_', 'NEW', 'NEWORNIL', 'DISPOSE', 'READ', 'WRITE', 'READLN', 'WRITELN', 'SETLENGTH',
 			'VAL','STR', 'EXIT');
 		specialfuncnames: array [SpecialFunc] of string[8] = (
 			'_', 'TRUNC', 'FRAC', 'INT', 'SQR', 'SUCC', 'PRED', 'ODD',
@@ -2186,7 +2186,7 @@ begin
 	if ch = '!' then
 	(* special comment till end of line *)
 	begin
-		while not (nextChar = #13) do (* nothing *);
+		while not (nextChar in [#13, #10]) do (* nothing *);
 		readNextToken;
 	end
 	else
@@ -2456,10 +2456,7 @@ begin
 	begin
 		digits := curToken.tokenText;
 		if matchTokenOrNot(MinusToken) then
-		begin
-			readNextToken;
 			digits := digits + curToken.tokenText;
-		end;
 		parseInteger := integerFromString(digits);
 	end;
 	readNextToken;
@@ -2812,6 +2809,8 @@ begin
 
 		if checkToken(CommaToken) then
 		begin
+			(* TODO: handle comma syntax for indexing a char
+				from an array of strings *)
 			if elType.baseType <> ArrayType then
 				errorExit2('invalid array subscript for', name)
 		end;
@@ -3231,10 +3230,22 @@ begin
 	readNextToken;
 end;
 
+(* Handle an array range part. Very similar to parseInteger
+   but additionally handles Boolean, Enum and Char types which
+   can be used for array indices *)
 procedure getRangePart(var value:integer; var typeReturn: TypeSpec);
 var cnst: ConstRef;
+    negate:boolean;
+	digits: string[12];
 begin
 	setBaseType(typeReturn, NoType);
+	negate := false;
+
+	if checkToken(MinusToken) then
+	begin
+		negate := true;
+		readNextToken;
+	end;
 
 	if checkToken(IdentToken) then
 	begin
@@ -3268,7 +3279,11 @@ begin
 	else
 	begin
 		setBaseType(typeReturn, IntegerType);
-		value := parseInteger;
+		digits := curToken.tokenText;
+		if negate then
+			insert('-', digits, 1);
+		value := integerFromString(digits);
+		readNextToken;
 	end;
 end;
 
@@ -3433,9 +3448,9 @@ begin
 				if savedType.baseType = NoType then
 					savedType := elementType;
 				emitLoadConstantInt(cnst^.intValue);
+				readNextToken;
 			end;
 			emitAddToSet;
-			readNextToken;
 		end
 		else if checkToken(NumberToken) then
 		begin
@@ -3999,6 +4014,8 @@ begin
 		begin
 			readNextToken;
 			length := parseInteger;
+			if length < 1 then
+				errorExit2('invalid string length', '');
 			matchToken(RBracketToken);
 		end;
 		typSpec.size := getStringMemSize(length);
@@ -4483,7 +4500,7 @@ begin
 	isFunction := aProc^.returnType.baseType <> NoType;
 end;
 
-procedure parseNew;
+procedure parseNew(checkNil:boolean);
 var memLoc: MemLocation;
     typeReturn: TypeSpec;
 begin
@@ -4509,17 +4526,17 @@ begin
 		emitLoadConstantInt(memLoc.typ.pointedType^.size);
 		emitMemAlloc;
 
+		(*We need to call CLEARMEM when the allocated type
+			contains strings.
+			INITSTRING checks if the header is non-zero to see if
+			the string is already initialized, and the allocated
+			chunk might contain random data so it would look
+			like an initialized string. *)
 		if typeContainsString(memLoc.typ.pointedType^) then
 			emitClearAlloc(memLoc.typ.pointedType);
 	end;
-	emitCheckAlloc;
+	if checkNil then
-
+		emitCheckAlloc;
-	(*We need to call CLEARMEM when the allocated type
-		contains strings.
-		INITSTRING checks if the header is non-zero to see if
-		the string is already initialized, and the allocated
-		chunk might contain random data so it would look
-		like an initialized string. *)
 
 	writeVariable(memLoc);
 
@@ -5000,7 +5017,9 @@ begin
 	NoSP:
 		errorExit2('internal error in parseSpecialProcCall', lastToken.tokenText);
 	NewSP:
-		parseNew;
+		parseNew(true);
+	New0SP:
+		parseNew(false);
 	DisposeSP:
 		parseDispose;
 	ReadSP:

pcomp/sasm.pas

@@ -1,7 +1,7 @@
 (* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
 {$MODE objfpc}
 {$H600}
-{$S4}
+{$S32}
 program sasm;
 {$!}{$ifdef FPC}uses math,crt;{$endif}
 {$R+}
@@ -1515,9 +1515,7 @@ begin
 		end;
 
 		if dref^.symboldata.value <> value then
-			(* writeln('////// label changed value ', keyword, ' ',
+			dref^.symboldata.value := value;
-				dref^.symboldata.value, ' -> ', value); *)
-		dref^.symboldata.value := value;
 	end;
 end;
 
@@ -1872,9 +1870,9 @@ begin
 		if (pc and 3) = 0 then	(* no padding *)
 		begin
 			pad := false;
-			(* total size 8 bytes *)
+			(* total size 10 bytes *)
 			offset := 4;	(* offset for LOADREL *)
-			shrinkage := 6; (* difference to short form size *)
+			shrinkage := 8; (* difference to short form size *)
 		end
 		else
 		begin
@@ -1892,9 +1890,17 @@ begin
 		encodeInstruction('JUMP', 0, encoded);
 		emitInstructionWord(encoded);
 
+		(* Padding is always done, so the length of the sequence does
+			not change depending on the position. The pad is either
+			placed before the address to align it on a word address,
+			or after, if it is already aligned. *)
 		if pad then
 			emitInstructionWord(0);
+
 		emitWord(value);
+
+		if not pad then
+			emitInstructionWord(0);
 	end
 	else
 	begin
@@ -1937,9 +1943,9 @@ begin
 		if (pc and 3) = 2 then (* no padding *)
 		begin
 			pad := false;
-			(* total size 10 bytes *)
+			(* total size 12 bytes *)
 			offset := 4;	(* offset for LOADREL *)
-			shrinkage := 8; (* difference to short form size *)
+			shrinkage := 10; (* difference to short form size *)
 		end
 		else
 		begin
@@ -1967,9 +1973,17 @@ begin
 		encodeInstruction('JUMP', 0, encoded);
 		emitInstructionWord(encoded);
 
+		(* Padding is always done, so the length of the sequence does
+			not change depending on the position. The pad is either
+			placed before the address to align it on a word address,
+			or after, if it is already aligned. *)
 		if pad then
 			emitInstructionWord(0);
+
 		emitWord(value);
+
+		if not pad then
+			emitInstructionWord(0);
 	end
 	else
 	begin
@@ -2042,6 +2056,9 @@ begin
 			operandValue := 0;
 		emitBlock(count, operandValue);
 	end
+	else
+	if lastToken.tokenText = '.ALIGN' then
+		alignOutput(wordSize)
 	else
 		errorExit2('Unrecognized directive', lastToken.tokenText);
 end;

progs/changemem.pas

@@ -0,0 +1,173 @@
+program changemem;
+const ProgramMagic = $00100AFE;
+type ProgramHeader = record
+		magic:integer;
+		heapSize:integer;
+		stackSize:integer;
+		mainPtr:integer;
+	end;
+
+var filename:string;
+    h:ProgramHeader;
+
+procedure showHex(value:integer);
+var i:integer;
+    digit:integer;
+    digits:array[1..8] of char;
+    ch:char;
+begin
+	for i := 1 to 8 do
+	begin
+		digit := value and 15;
+		value := value shr 4;
+
+		if digit < 10 then
+			ch := chr(digit + ord('0'))
+		else
+			ch := chr(digit - 10 + ord('A'));
+		digits[i] := ch;
+	end;
+	for i := 8 downto 1 do
+		write(digits[i]);
+end;
+
+procedure showValue(labl:string; value:integer);
+begin
+	write(labl:20, ' ');
+	write(value:8, ' (');
+	showHex(value);
+	writeln(')');
+end;
+
+procedure showHeader(var h:ProgramHeader);
+begin
+	showValue('heap size', h.heapSize);
+	showValue('stack size', h.stackSize);
+	showValue('main entry point', h.mainPtr);
+end;
+
+procedure readHeader(var filename:string;var h:ProgramHeader);
+var f:file;
+begin
+	writeln('reading file ', filename);
+	open(f, filename, ModeReadOnly);
+	if IOResult(f) <> 0 then
+	begin
+		writeln('Error opening file: ', ErrorStr(IOResult(f)));
+		halt;
+	end
+	else
+	begin
+		read(f, h);
+		if IOResult(f) <> 0 then
+		begin
+			writeln('Error reading header: ', ErrorStr(IOResult(f)));
+			halt;
+		end;
+		close(f);
+	end;
+end;
+
+procedure writeHeader(var filename:string;var h:ProgramHeader);
+var f:file;
+begin
+	writeln('writing file ', filename);
+	open(f, filename, ModeModify);
+	if IOResult(f) <> 0 then
+	begin
+		writeln('Error opening file: ', ErrorStr(IOResult(f)));
+		halt;
+	end
+	else
+	begin
+		write(f, h);
+		if IOResult(f) <> 0 then
+		begin
+			writeln('Error writing header: ', ErrorStr(IOResult(f)));
+			halt;
+		end;
+		close(f);	
+	end;
+end;
+
+procedure modifyHeader(var filename:string;var h:ProgramHeader);
+var done:boolean;
+    ch:char;
+    changed:boolean;
+
+	function getNewValue(descr:string):integer;
+	var buf:string;
+	    v,e:integer;
+	begin
+		getNewValue := 0;
+		write('New ',descr, ' size (decimal)> ');
+		readln(buf);
+		val(buf, v, e);
+		if(e > 0 ) or (v <= 0) then
+			writeln('invalid size')
+		else
+			getNewValue := v;
+	end;
+	
+	procedure changeStackSize;
+	var v:integer;
+	begin
+		v := getNewValue('stack');
+		if v > 0 then
+		begin
+			h.stackSize := v;
+			changed := true;
+		end;	
+	end;
+
+	procedure changeHeapSize;
+	var v:integer;
+	begin
+		v := getNewValue('heap');
+		if v > 0 then
+		begin
+			h.heapSize := v;
+			changed := true;
+		end;
+	end;
+
+begin
+	changed := false; done := false;
+
+	while not done do
+	begin
+		writeln(filename, ' header:');
+		showHeader(h);
+		writeln('Change H)eap size   Change S)tack size   eX)it');
+		write('> ');
+		read(ch);
+		writeln;
+		case upcase(ch) of
+		'S': changeStackSize;
+		'H': changeHeapSize;
+		'X': done := true;
+		else
+			writeln('invalid command');
+		end;
+	end;
+
+	if changed then
+		writeHeader(filename, h);
+end;
+
+begin
+	if ParamCount > 0 then
+		filename := ParamStr(1)
+	else
+	begin
+		write('File name> ');
+		readln(filename);
+	end;
+
+	readHeader(filename, h);
+
+	if h.magic <> ProgramMagic then
+		writeln('invalid magic value ', h.magic)
+	else
+		modifyHeader(filename, h);
+end.

progs/dumpdir.pas

@@ -14,8 +14,8 @@ var dirs:DirectorySlot;
     error:integer;
 begin
 	lastSlot := volumeTable[volid].part.dirSize - 1;
-	openvolumeid(volid);
+	openvolumeid(volid, error); (* we just ignore error here because
-
+		we should always have enough heap space *)
 	for i := 0 to lastSlot do
 	begin
 		getdirslot(volid, i, dirs, error);

progs/reclaim.pas

@@ -123,7 +123,8 @@ begin
 		freeAreaCount := 0;
 		lastUsed := 0;
 
-		openvolumeid(volid);
+		openvolumeid(volid, error);
+			(* ignoring theoretically possible out-of-heap-error *)
 		i := 0;
 		endSlot := volumeTable[volid].part.dirSize - 1;
 
@@ -308,7 +309,7 @@ begin
 		writeln('Volume ', volname, ' not found.')
 	else
 	begin
-		openvolumeid(volid);
+		openvolumeid(volid, error);
 
 		endSlot := volumeTable[volid].part.dirSize - 1;
 		extentSize := volumeTable[volid].part.extentSize;

progs/recover.pas

@@ -0,0 +1,167 @@
+(* Copyright 2025 Sebastian Lederer. See the file LICENSE.md for details *)
+program recover;
+const PageMargin = 4;
+var filename:string;
+    volid:integer;
+
+(* we use some stuff internal to stdlib.pas *)
+procedure getdirslot(volumeid:integer;slotNo:integer;var result:DirectorySlot;var error:integer);
+	external;
+procedure openfile(volid:integer; slotno:integer; var dirslot:DirectorySlot; var aFile:File; mode:filemode);
+	external;
+
+function openvolume:integer;
+var volid:integer;
+begin
+	openvolume := -1;
+
+	volid := findvolume(DefaultVolume);
+	if volid < 1 then
+		writeln('Volume ', DefaultVolume, ' not found.')
+	else
+		openvolume := volid;
+end;
+
+procedure waitForKey;
+var c:char;
+begin
+	writeln;
+	writeln('-- press any key to continue --');
+	c := conin;
+end;
+
+procedure copyfile(volid:integer;slotno:integer;oldname,newname:string);
+var srcfile,destfile:file;
+    dirslot:DirectorySlot;
+    error:integer;
+    ch:char;
+    count:integer;
+begin
+	(* to open the deleted source file, we emulate parts
+		of the open procedure from stdlib *)
+	getdirslot(volid, slotno, dirslot, error);
+	if not (SlotDeleted in dirslot.flags)  or (dirslot.name <> oldname) then
+		writeln('Invalid slot ', slotno)
+	else
+	begin
+		openfile(volid, slotno, dirslot, srcfile, ModeReadOnly);
+		if error <> 0 then
+			writeln('Error opening file from slot ', slotno,
+				': ', ErrorStr(error))
+		else
+		begin
+			open(destfile, newname, ModeCreate);
+			if IOResult(destfile) = IOFileExists then
+			begin
+				write('File ', newname, ' already exists, overwrite? [y/n] ');
+				readln(ch);
+				if ch in ['Y', 'y'] then
+					open(destfile, newname, ModeOverwrite);
+			end;
+			if IOResult(destfile) <> 0 then
+				writeln('Error opening ', newname, ': ',
+					ErrorStr(IOResult(destfile)))
+			else
+			begin
+				(* taken from shell.pas copyFile *)
+				write('Recovering from slot ', slotno, ' to ', newname, '...');
+				count := 0;
+				while not eof(srcfile) do
+				begin
+					read(srcfile,ch);
+					write(destfile,ch);
+					count := count + 1;
+					if (count and 8191) = 0 then write('.');
+				end;
+				writeln;
+				close(destfile);
+			end;
+			close(srcfile);
+		end;
+	end;
+end;
+
+procedure recoverfile(volid:integer;wantedname:string);
+var dirs:DirectorySlot;
+    i:integer;
+    lastSlot:integer;
+    error:integer;
+    screenW,screenH:integer;
+    count:integer;
+    datestr:string;
+    ftime:DateTime;
+    wantedslot:integer;
+    newname:string;
+    foundsomething:boolean;
+begin
+	writeln('Files available for recovery:');
+	foundsomething := false;
+	newname := '';
+
+	GetTermSize(screenW, screenH);
+	count := PageMargin;
+
+	lastSlot := volumeTable[volid].part.dirSize - 1;
+	openvolumeid(volid, error);
+		(* ignoring theoretically possible out-of-heap-space error *)
+	for i := 0 to lastSlot do
+	begin
+		getdirslot(volid, i, dirs, error);
+		with dirs do
+		begin
+			if (SlotFirst in flags) or (SlotDeleted in flags) then
+				if name = wantedname then
+				begin
+					ftime := GetDateTime(dirs.modTime);
+					datestr := DateStr(ftime) + ' ' + TimeStr(ftime, true);
+					write('slot ', i:4, name:34, sizeBytes:8, datestr:21, '  ');
+					if SlotFirst in flags then write('Cur');
+					if SlotExtent in flags then write('Extent');
+					if SlotReserved in flags then write('Resvd');
+					if SlotDeleted in flags then write('Del');
+					if SlotFree in flags then write('Free');
+					if SlotEndScan in flags then write('End');
+					writeln;
+					foundsomething := true;
+					count := count + 1;
+					if count >= screenH then
+					begin
+						count := PageMargin;
+						waitForKey;
+					end;
+					if SlotEndScan in flags then break;
+				end;
+		end;
+	end;
+
+	if foundsomething  then
+	begin
+		write('Slot no to recover> ');
+		readln(wantedslot);
+		if (wantedslot < 1) or (wantedslot >= volumeTable[volid].part.dirSize) then
+			writeln('Invalid slot number.')
+		else
+		begin
+			write('New filename> ');
+			readln(newname);
+		end;
+
+		if length(newname) > 0 then
+			copyfile(volid, wantedslot, wantedname, newname);
+	end;
+
+	closevolumeid(volid);
+end;
+
+begin
+	if ParamCount > 0 then
+		filename := ParamStr(1)
+	else
+	begin
+		write('Filename to recover> ');
+		readln(filename);
+	end;
+	volid := openvolume;
+	if volid > 0 then
+		recoverfile(volid, filename);
+end.

progs/shell.pas

@@ -149,7 +149,7 @@ begin
 		count := PageMargin;
 
 		writeln('reading directory of ', DefaultVolume);
-		openvolumeid(volid);
+		openvolumeid(volid, error);
 		readdirfirst(volid, index, dirs, error);
 		while index > 0 do
 		begin

progs/xfer.pas

@@ -226,6 +226,7 @@ begin
 	if not invalid then
 	begin
 		open(xferFile, filename, ModeOverwrite);
+		blockNo := 0;
 		done := false;
 		repeat
 			serReadBlock(ok);
@@ -398,7 +399,7 @@ begin
 		writeln('Volume ', DefaultVolume, ' not found.')
 	else
 	begin
-		openvolumeid(volid);
+		openvolumeid(volid, error);
 		readdirfirst(volid, index, dirs, error);
 		while (index > 0) and (error = 0) do
 		begin

rogue

@@ -0,0 +1 @@
+Subproject commit 73936b4167bad01642675252e53a096d80fa6b35

tests/arraytest.pas

@@ -0,0 +1,8 @@
+program arraytest;
+var arr:array[-5..5] of integer;
+    var s:string[5];
+begin
+	arr[-5] := 10;
+	arr[5] := 11;
+	writeln(arr[-5], ' ', arr[5]);
+end.

tests/nestedtest.pas

@@ -0,0 +1,49 @@
+program NestedTest;
+var g:integer;
+
+procedure first;
+var f:integer;
+
+  procedure second;
+  var s:integer;
+
+    procedure third1;
+    var t1:integer;
+    begin
+	    t1 := 310;
+	    s := 31;
+	    writeln('t1:', t1);
+    end;
+
+    procedure third2;
+    var t2:integer;
+    begin
+	    t2 := 320;
+	    s := 32;
+	    writeln('t2:', t2);
+	    if g <> 21 then
+	    begin
+	        g := 21;
+		second;
+	    end;
+    end;
+
+  begin
+	  f := 2;
+	  writeln('g:',g);
+	  third1;
+	  writeln('g:', g);
+	  third2;
+	  writeln('s:',s);
+  end;
+
+begin
+	second;
+	writeln('f:', f);
+end;
+
+begin
+	g := 0;
+	first;
+	writeln('g:', g);
+end.

tests/settest2.pas

@@ -0,0 +1,20 @@
+program settest2;
+type weekday = (Mon,Tue,Wed,Thu,Fri,Sat,Sun);
+     days = set of weekday;
+
+var s:days;
+    d:weekday;
+
+begin
+	s := [Sat,Sun]; (* set literal  *)
+
+	d := Sun;
+	if d in [Sat,Sun] then (* array literal *)
+		writeln('weekend');
+
+	if d in s then
+		writeln('also weekend');
+
+	d := Mon;
+	s := s + [d];
+end.

tridoracpu/tridoracpu.srcs/Arty-A7-35-Master.xdc

@@ -8,8 +8,8 @@ set_property -dict {PACKAGE_PIN E3 IOSTANDARD LVCMOS33} [get_ports clk]
 create_clock -period 10.000 -name sys_clk_pin -waveform {0.000 5.000} -add [get_ports clk]
 
 ## Switches
-set_property -dict {PACKAGE_PIN A8 IOSTANDARD LVCMOS33} [get_ports sw0]
+#set_property -dict {PACKAGE_PIN A8 IOSTANDARD LVCMOS33} [get_ports sw0]
-set_property -dict {PACKAGE_PIN C11 IOSTANDARD LVCMOS33} [get_ports sw1]
+#set_property -dict {PACKAGE_PIN C11 IOSTANDARD LVCMOS33} [get_ports sw1]
 #set_property -dict { PACKAGE_PIN C10   IOSTANDARD LVCMOS33 } [get_ports { sw[2] }]; #IO_L13N_T2_MRCC_16 Sch=sw[2]
 #set_property -dict { PACKAGE_PIN A10   IOSTANDARD LVCMOS33 } [get_ports { sw[3] }]; #IO_L14P_T2_SRCC_16 Sch=sw[3]
 
@@ -34,7 +34,7 @@ set_property -dict {PACKAGE_PIN T9 IOSTANDARD LVCMOS33} [get_ports led2]
 set_property -dict {PACKAGE_PIN T10 IOSTANDARD LVCMOS33} [get_ports led3]
 
 ## Buttons
-set_property -dict {PACKAGE_PIN D9 IOSTANDARD LVCMOS33} [get_ports btn0]
+#set_property -dict {PACKAGE_PIN D9 IOSTANDARD LVCMOS33} [get_ports btn0]
 #set_property -dict { PACKAGE_PIN C9    IOSTANDARD LVCMOS33 } [get_ports { btn1 }]; #IO_L11P_T1_SRCC_16 Sch=btn[1]
 #set_property -dict { PACKAGE_PIN B9    IOSTANDARD LVCMOS33 } [get_ports { btn[2] }]; #IO_L11N_T1_SRCC_16 Sch=btn[2]
 #set_property -dict { PACKAGE_PIN B8    IOSTANDARD LVCMOS33 } [get_ports { btn[3] }]; #IO_L12P_T1_MRCC_16 Sch=btn[3]
@@ -70,10 +70,10 @@ set_property -dict {PACKAGE_PIN V14 IOSTANDARD LVCMOS33} [get_ports VGA_VS_O]
 #set_property -dict { PACKAGE_PIN U13   IOSTANDARD LVCMOS33 } [get_ports { jc[7] }]; #IO_L23N_T3_A02_D18_14 Sch=jc_n[4]
 
 ## Pmod Header JD
-#set_property -dict { PACKAGE_PIN D4    IOSTANDARD LVCMOS33 } [get_ports { jd[0] }]; #IO_L11N_T1_SRCC_35 Sch=jd[1]
+set_property -dict { PACKAGE_PIN D4    IOSTANDARD LVCMOS33 } [get_ports { amp2_ain }]; #IO_L11N_T1_SRCC_35 Sch=jd[1]
-#set_property -dict { PACKAGE_PIN D3    IOSTANDARD LVCMOS33 } [get_ports { jd[1] }]; #IO_L12N_T1_MRCC_35 Sch=jd[2]
+set_property -dict { PACKAGE_PIN D3    IOSTANDARD LVCMOS33 } [get_ports { amp2_gain }]; #IO_L12N_T1_MRCC_35 Sch=jd[2]
 #set_property -dict { PACKAGE_PIN F4    IOSTANDARD LVCMOS33 } [get_ports { jd[2] }]; #IO_L13P_T2_MRCC_35 Sch=jd[3]
-#set_property -dict { PACKAGE_PIN F3    IOSTANDARD LVCMOS33 } [get_ports { jd[3] }]; #IO_L13N_T2_MRCC_35 Sch=jd[4]
+set_property -dict { PACKAGE_PIN F3    IOSTANDARD LVCMOS33 } [get_ports { amp2_shutdown_n }]; #IO_L13N_T2_MRCC_35 Sch=jd[4]
 #set_property -dict { PACKAGE_PIN E2    IOSTANDARD LVCMOS33 } [get_ports { jd[4] }]; #IO_L14P_T2_SRCC_35 Sch=jd[7]
 #set_property -dict { PACKAGE_PIN D2    IOSTANDARD LVCMOS33 } [get_ports { jd[5] }]; #IO_L14N_T2_SRCC_35 Sch=jd[8]
 #set_property -dict { PACKAGE_PIN H2    IOSTANDARD LVCMOS33 } [get_ports { jd[6] }]; #IO_L15P_T2_DQS_35 Sch=jd[9]

tridoracpu/tridoracpu.srcs/dram_bridge.v

@@ -107,8 +107,14 @@ module dram_bridge #(ADDR_WIDTH = 32, WIDTH = 32)
     );
 
     (*KEEP*) reg [DRAM_DATA_WIDTH-1:0] 	ins_cache;
-    (*KEEP*) reg [DRAM_ADDR_WIDTH-1:4]  cached_addr;
+    (*KEEP*) reg [DRAM_ADDR_WIDTH-1:4]  icached_addr;
-    (*KEEP*) wire 		      	        cache_hit = mem_read_enable && mem_read_ins && (cached_addr == mem_addr[DRAM_ADDR_WIDTH-1:4]);
+    (*KEEP*) wire                       icache_hit = mem_read_enable && mem_read_ins && (icached_addr == mem_addr[DRAM_ADDR_WIDTH-1:4]);
+
+    (*KEEP*) reg [DRAM_DATA_WIDTH-1:0] 	d_cache;
+    (*KEEP*) reg [DRAM_ADDR_WIDTH-1:4]  dcached_addr;
+    (*KEEP*) wire                       dcache_hit = mem_read_enable && !mem_read_ins && (dcached_addr == mem_addr[DRAM_ADDR_WIDTH-1:4]);
+
+    wire cache_hit = icache_hit | dcache_hit;
 
     reg [WIDTH-1:0] read_buf;
     reg read_inprogress = 0;
@@ -125,25 +131,32 @@ module dram_bridge #(ADDR_WIDTH = 32, WIDTH = 32)
     wire [1:0] word_sel = mem_addr[3:2];
 
     wire [WIDTH-1:0] read_word =
-                        word_sel == 3'b11 ? app_rd_data[31:0]  :
+                        word_sel == 2'b11 ? app_rd_data[31:0]  :
-                        word_sel == 3'b10 ? app_rd_data[63:32] :
+                        word_sel == 2'b10 ? app_rd_data[63:32] :
-                        word_sel == 3'b01 ? app_rd_data[95:64] :
+                        word_sel == 2'b01 ? app_rd_data[95:64] :
                                             app_rd_data[127:96];
 
-    wire [WIDTH-1:0] read_cached_word =
+    wire [WIDTH-1:0] read_icached_word =
-                        word_sel == 3'b11 ? ins_cache[31:0]  :
+                        word_sel == 2'b11 ? ins_cache[31:0]  :
-                        word_sel == 3'b10 ? ins_cache[63:32] :
+                        word_sel == 2'b10 ? ins_cache[63:32] :
-                        word_sel == 3'b01 ? ins_cache[95:64] :
+                        word_sel == 2'b01 ? ins_cache[95:64] :
                                             ins_cache[127:96];
 
-    (*KEEP*) assign mem_read_data = cache_hit ? read_cached_word :
+    wire [WIDTH-1:0] read_dcached_word =
+                        word_sel == 2'b11 ? d_cache[31:0]  :
+                        word_sel == 2'b10 ? d_cache[63:32] :
+                        word_sel == 2'b01 ? d_cache[95:64] :
+                                            d_cache[127:96];
+
+    (*KEEP*) assign mem_read_data = icache_hit ? read_icached_word :
+                            dcache_hit ? read_dcached_word :
                             app_rd_data_valid ? read_word : read_buf;
 
     // set the write mask according to the lower bits of the address
     // (ignoring bit 0)
-    assign app_wdf_mask = word_sel == 3'b11 ? 16'b1111111111110000 :
+    assign app_wdf_mask = word_sel == 2'b11 ? 16'b1111111111110000 :
-                          word_sel == 3'b10 ? 16'b1111111100001111 :
+                          word_sel == 2'b10 ? 16'b1111111100001111 :
-                          word_sel == 3'b01 ? 16'b1111000011111111 :
+                          word_sel == 2'b01 ? 16'b1111000011111111 :
                                               16'b0000111111111111 ;
 
     wire write_ready = mem_write_enable & app_wdf_rdy & app_rdy;
@@ -160,25 +173,58 @@ module dram_bridge #(ADDR_WIDTH = 32, WIDTH = 32)
     assign app_cmd = dram_read_enable ? CMD_READ : CMD_WRITE;
 
 
+    /* set instruction cache */
     always @(posedge dram_front_clk)
     begin
         if(dram_read_enable && mem_read_ins && app_rd_data_valid)
         begin
             ins_cache <= app_rd_data;
-            cached_addr <= mem_addr[DRAM_ADDR_WIDTH-1:4];
+            icached_addr <= mem_addr[DRAM_ADDR_WIDTH-1:4];
         end
     end
 
+    /* set data cache */
+    always @(posedge dram_front_clk)
+    begin
+        if(dram_read_enable && !mem_read_ins && app_rd_data_valid)
+        begin
+            d_cache <= app_rd_data;
+            dcached_addr <= mem_addr[DRAM_ADDR_WIDTH-1:4];
+        end
+        
+        /* write-through cache - invalidate on write */
+        /* invalidate data cache on write */
+//         if(mem_write_enable && dcached_addr == mem_addr[DRAM_ADDR_WIDTH-1:4])
+//            dcached_addr <= {DRAM_ADDR_WIDTH-4{1'b1}};
+
+        /* write-back cache - update cache on write */
+        // write back to data cache on mem_write
+        if(mem_write_enable && dcached_addr == mem_addr[DRAM_ADDR_WIDTH-1:4])
+        begin
+            case(word_sel)
+                2'b11: d_cache[31:0] <= mem_write_data;
+                2'b10: d_cache[63:32] <= mem_write_data;
+                2'b01: d_cache[95:64] <= mem_write_data;
+                2'b00: d_cache[127:96] <= mem_write_data;
+            endcase            
+        end
+    end
+
+    /* transfer read data, either from cache or from DRAM */
     always @(posedge dram_front_clk)
     begin
         if(dram_read_enable & ~read_inprogress & app_rdy)
             read_inprogress <= 1;
         if(read_inprogress & app_rd_data_valid)
             read_inprogress <= 0;
+
         if(dram_read_enable & app_rd_data_valid)
             read_buf <= mem_read_data;
         else
-        if (mem_read_enable & cache_hit)
+        if (mem_read_enable & icache_hit)
-            read_buf <= read_cached_word;
+            read_buf <= read_icached_word;
+        else
+        if (mem_read_enable & dcache_hit)
+            read_buf <= read_dcached_word;
     end
 endmodule

tridoracpu/tridoracpu.srcs/irqctrl.v

@@ -1,6 +1,6 @@
 `timescale 1ns / 1ps
 
-module irqctrl #(IRQ_LINES = 2, IRQ_DELAY_WIDTH = 4) (
+module irqctrl #(IRQ_LINES = 3, IRQ_DELAY_WIDTH = 4) (
         input wire clk,
         input wire [IRQ_LINES-1:0] irq_in,
         input wire cs,

tridoracpu/tridoracpu.srcs/mem.v

@@ -91,8 +91,10 @@ module mem #(parameter ADDR_WIDTH = 32,
   // RAM1 $1000 - $FFFF 60K
   // RAM2 $10000 - $FFFFFFFF ~4GB
 
+  localparam RAM1_ADDR_WIDTH = 16;
+
   wire ram_cs = addr[ADDR_WIDTH-1:12] != { {(ADDR_WIDTH-12){1'b0}}};
-  wire ram1_cs = ram_cs && (addr[ADDR_WIDTH-1:16] == { {(ADDR_WIDTH-16){1'b0}}});
+  wire ram1_cs = ram_cs && (addr[ADDR_WIDTH-1:RAM1_ADDR_WIDTH] == { {(ADDR_WIDTH-RAM1_ADDR_WIDTH){1'b0}}});
   wire ram2_cs = ram_cs && !ram1_cs;
   wire rom_cs = !ram_cs && addr[11] == 1'b0;
   wire io_cs = !ram_cs && addr[11]  == 1'b1;
@@ -116,10 +118,10 @@ module mem #(parameter ADDR_WIDTH = 32,
   // test
   reg [1:0] wait_state;
 
-  ram32 #(.ADDR_WIDTH(16)) ram0  // 64KB RAM
+  ram32 #(.ADDR_WIDTH(RAM1_ADDR_WIDTH)) ram0  // 64KB RAM
   (
     .clk(clk),
-    .addr(addr[15:0]),
+    .addr(addr[RAM1_ADDR_WIDTH-1:0]),
     .data_out(ram_out),
     .read_enable(ram_read),
     .data_in(data_in),

tridoracpu/tridoracpu.srcs/stackcpu.v

@@ -16,11 +16,11 @@ module stackcpu #(parameter ADDR_WIDTH = 32, WIDTH = 32,
     output wire write_enable,
     input wire mem_wait,
     
-    output wire led1,
+    output wire debug1,
-    output wire led2,
+    output wire debug2,
-    output wire led3
+    output wire debug3
     );
-    
+
     localparam EVAL_STACK_INDEX_WIDTH = 6;
 
     wire reset = !rst;
@@ -90,7 +90,6 @@ module stackcpu #(parameter ADDR_WIDTH = 32, WIDTH = 32,
     wire mem_write;
     
     wire x_is_zero;
-    // wire [WIDTH-1:0] y_plus_operand = Y + operand;
 
     wire x_equals_y = X == Y;
     wire y_lessthan_x  = $signed(Y) < $signed(X);
@@ -105,16 +104,10 @@ module stackcpu #(parameter ADDR_WIDTH = 32, WIDTH = 32,
     assign write_enable = mem_write_enable;
 
     // debug output ------------------------------------------------------------------------------------
-    assign led1 = reset;
+    assign debug1 = reset;
-    assign led2 = ins_loadc;
+    assign debug2 = ins_loadc;
-    assign led3 = ins_branch;
+    assign debug3 = ins_branch;
-//    assign debug_out1 = { mem_read_enable, mem_write_enable, x_is_zero,
+
-//                    ins_branch, ins_aluop, y_lessthan_x, x_equals_y, {7{1'b0}}, seq_state};
-//    assign debug_out2 = data_in;
-//    assign debug_out3 = nX;
-//    assign debug_out4 = nPC;
-//    assign debug_out5 = ins;
-//    assign debug_out6 = IV;
     //--------------------------------------------------------------------------------------------------
 
     // instruction decoding

tridoracpu/tridoracpu.srcs/tdraudio.v

@@ -0,0 +1,270 @@
+`timescale 1ns / 1ps
+
+// waveform generator module (PCM)
+module wavegen #(DATA_WIDTH=32, CLOCK_DIV_WIDTH=22,
+    AMP_WIDTH=16, AMP_BIAS=32768) (
+        input wire clk,
+        input wire reset,
+        input wire [1:0] reg_sel,
+        output wire [DATA_WIDTH-1:0] rd_data,
+        input wire [AMP_WIDTH-1:0] wr_data,
+        input wire rd_en,
+        input wire wr_en,
+
+        output wire [AMP_WIDTH-1:0] amp_val,
+        output wire running,
+        output wire irq
+    );
+
+    localparam TDRAU_REG_CTL = 0;  /* control register */
+    localparam TDRAU_REG_CLK = 1;  /* clock divider register */
+    localparam TDRAU_REG_AMP = 2;  /* amplitude (volume) register */
+
+     /* avoid warning about unconnected port */
+    (* keep="soft" *) wire _unused = rd_en;
+
+    reg channel_enable;
+    reg [CLOCK_DIV_WIDTH-1:0] clock_div;
+    reg [CLOCK_DIV_WIDTH-1:0] div_count;
+    reg amp_phase;
+    reg [AMP_WIDTH-1:0] amp_out;
+
+
+    wire fifo_wr_en;
+    wire fifo_rd_en, fifo_full, fifo_empty;
+    wire [AMP_WIDTH-1:0] fifo_rd_data;
+
+    fifo #(.ADDR_WIDTH(4), .DATA_WIDTH(16)) sample_buf(
+        clk, reset,
+        fifo_wr_en, fifo_rd_en,
+        wr_data[AMP_WIDTH-1:0], fifo_rd_data,
+        fifo_full,
+        fifo_empty
+    );
+
+    assign fifo_rd_en = (div_count == 0) && channel_enable && ~fifo_empty;
+    assign fifo_wr_en = wr_en && (reg_sel == TDRAU_REG_AMP);
+
+    reg irq_buf, irq_enable;
+    assign irq = channel_enable && irq_buf;
+
+    reg [DATA_WIDTH-1:0] rd_data_buf;
+    assign rd_data = rd_data_buf;
+
+    assign amp_val = amp_out;
+    assign running = channel_enable;
+
+    wire ctl_reg_write = wr_en && (reg_sel == TDRAU_REG_CTL);
+
+    /* update read data buffer */
+    always @(posedge clk)
+    begin
+        rd_data_buf <= {{DATA_WIDTH-8{1'b0}},
+            {3{1'b0}}, irq_enable, fifo_full, fifo_empty, amp_phase, channel_enable};
+    end
+
+    /* irq signal to interrupt controller */
+    always @(posedge clk)
+    begin
+        if(reset)
+            irq_buf <= 0;
+        else
+        if(fifo_empty && irq_enable)
+            irq_buf <= 1;
+        else
+            irq_buf <= 0;
+    end
+
+    /* interrupt enable flag  */
+    always @(posedge clk)
+    begin
+        if(reset)
+            irq_enable <= 0;
+        else
+        if(ctl_reg_write)
+            irq_enable <= wr_data[4];
+        else
+        if(irq_buf)
+            irq_enable <= 0;  // disable interrupts after an interrupt
+    end
+
+    /* channel enable flag */
+    always @(posedge clk)
+    begin
+        if(reset)
+            channel_enable <= 0;
+        else if (ctl_reg_write)
+            channel_enable <= wr_data[0];
+    end
+
+    /* clock divider register */
+    always @(posedge clk)
+    begin
+        if(reset)
+            clock_div <= 0;
+        else
+        if (wr_en && (reg_sel == TDRAU_REG_CLK))
+             clock_div <= wr_data;
+    end
+
+    /* divider counter */
+    always @(posedge clk)
+    begin
+        if(channel_enable)
+        begin
+            if(div_count == 0)      // reset counter if it reaches zero
+                div_count <= clock_div;
+            else
+                div_count <= div_count - 1;  // else just decrement it
+        end
+        else
+        if (wr_en && (reg_sel == TDRAU_REG_CLK)) // when setting divider,
+                div_count <= 1; // start cycle on next clock tick
+    end
+
+    /* amplitude out */
+    always @(posedge clk)
+    begin
+        if (reset)
+        begin
+            amp_out <= AMP_BIAS;
+            amp_phase <= 1;
+        end
+        else
+        if (channel_enable)
+        begin
+            if (div_count == 0) // invert amplitude on clock tick
+            begin
+                amp_out <=  fifo_rd_data;
+                amp_phase <= ~amp_phase;
+            end
+        end
+        else
+            amp_out <= AMP_BIAS;
+
+        // reset phase bit when enabling the channel
+        if (ctl_reg_write && wr_data[0] && ~channel_enable)
+            // when channel is being enabled, phase will be flipped on next tick
+            // because div_count will become zero
+            amp_phase <= 1;
+    end
+endmodule
+
+module tdraudio #(DATA_WIDTH=32) (
+        input wire clk,
+        input wire reset,
+        input wire [6:0] io_addr,
+        output wire [DATA_WIDTH-1:0] rd_data,
+        input wire [DATA_WIDTH-1:0] wr_data,
+        input wire rd_en,
+        input wire wr_en,
+        output wire irq_out,
+        output wire pdm_out,
+        output wire gain_sel,
+        output wire shutdown_n
+    );
+
+    localparam CLOCK_DIV_WIDTH = 22;
+    localparam AMP_WIDTH = 16;
+    localparam AMP_BIAS = 32768;
+    localparam DAC_WIDTH = 18;
+
+     /* avoid warning about unconnected port */
+    (* keep="soft" *) wire [DATA_WIDTH-1:AMP_WIDTH] _unused = wr_data[DATA_WIDTH-1:AMP_WIDTH];
+
+    wire [4:0] chan_sel = io_addr[6:2];
+    wire [1:0] reg_sel = io_addr[1:0];
+
+    wire [AMP_WIDTH-1:0] amp_wr_data = wr_data[AMP_WIDTH-1:0];
+
+    wire [AMP_WIDTH-1:0] chan0_amp;
+    wire [DATA_WIDTH-1:0] chan0_rd_data;
+    wire chan0_running;
+    wire chan0_irq;
+    wire chan0_sel = chan_sel == 5'd0;
+    wire chan0_rd_en = chan0_sel && rd_en;
+    wire chan0_wr_en = chan0_sel && wr_en;
+
+    wire [AMP_WIDTH-1:0] chan1_amp;
+    wire [DATA_WIDTH-1:0] chan1_rd_data;
+    wire chan1_running;
+    wire chan1_irq;
+    wire chan1_sel = chan_sel == 5'd1;
+    wire chan1_rd_en = chan1_sel && rd_en;
+    wire chan1_wr_en = chan1_sel && wr_en;
+
+    wire [AMP_WIDTH-1:0] chan2_amp;
+    wire [DATA_WIDTH-1:0] chan2_rd_data;
+    wire chan2_running;
+    wire chan2_irq;
+    wire chan2_sel = chan_sel == 5'd2;
+    wire chan2_rd_en = chan2_sel && rd_en;
+    wire chan2_wr_en = chan2_sel && wr_en;
+
+    wire [AMP_WIDTH-1:0] chan3_amp;
+    wire [DATA_WIDTH-1:0] chan3_rd_data;
+    wire chan3_running;
+    wire chan3_irq;
+    wire chan3_sel = chan_sel == 5'd3;
+    wire chan3_rd_en = chan3_sel && rd_en;
+    wire chan3_wr_en = chan3_sel && wr_en;
+
+    wire running = chan0_running || chan1_running || chan2_running || chan3_running;
+
+    assign rd_data = chan0_sel ? chan0_rd_data :
+                        chan1_sel ? chan1_rd_data :
+                        chan2_sel ? chan2_rd_data :
+                        chan3_sel ? chan3_rd_data :
+                        {DATA_WIDTH{1'b1}};
+
+    wavegen chan0(clk, reset, reg_sel,
+        chan0_rd_data, amp_wr_data,
+        chan0_rd_en, chan0_wr_en,
+        chan0_amp,
+        chan0_running, chan0_irq);
+
+    wavegen chan1(clk, reset, reg_sel,
+        chan1_rd_data, amp_wr_data,
+        chan1_rd_en, chan1_wr_en,
+        chan1_amp,
+        chan1_running, chan1_irq);
+
+    wavegen chan2(clk, reset, reg_sel,
+        chan2_rd_data, amp_wr_data,
+        chan2_rd_en, chan2_wr_en,
+        chan2_amp,
+        chan2_irq, chan2_running);
+
+    wavegen chan3(clk, reset, reg_sel,
+        chan3_rd_data, amp_wr_data,
+        chan3_rd_en, chan3_wr_en,
+        chan3_amp,
+        chan3_running, chan3_irq);
+
+    reg [DAC_WIDTH:0] deltasigma_acc; // one extra bit
+    wire [DAC_WIDTH:0] amp_sum = chan0_amp + chan1_amp + chan2_amp + chan3_amp; // also one overflow bit here
+    assign gain_sel = 1;  // gain select: 0 -> 12dB, 1 -> 6dB
+
+    // assign shutdown_n = running;
+    assign shutdown_n = 1;  /* don't enable shutdown mode, it creates a mains hum */
+
+    reg irq_out_buf;
+    assign irq_out = irq_out_buf;
+
+    always @(posedge clk) irq_out_buf <= chan0_irq || chan1_irq || chan2_irq || chan3_irq;
+
+    /* delta-sigma DAC */
+    always @(posedge clk)
+    begin
+        if(reset)
+            deltasigma_acc <= 0;
+        else
+//        if (running)
+            deltasigma_acc <= deltasigma_acc[DAC_WIDTH-1:0] + amp_sum;
+//        else
+//            deltasigma_acc <= deltasigma_acc[DAC_WIDTH-1:0] + (4*AMP_BIAS);
+    end
+
+    /* 1-bit audio output */
+    assign pdm_out = deltasigma_acc[DAC_WIDTH];
+endmodule

tridoracpu/tridoracpu.srcs/top.v

@@ -10,13 +10,11 @@
 //`define clock clk_1hz
 `define ENABLE_VGAFB
 `define ENABLE_MICROSD
+`define ENABLE_TDRAUDIO
 
 module top(
     input wire clk,
     input wire rst,
-    input wire btn0,
-    input wire sw0,
-    input wire sw1,
     output wire led0,
     output wire led1,
     output wire led2,
@@ -60,6 +58,13 @@ module top(
     output wire sd_sck,
     input wire  sd_cd
 `endif
+
+`ifdef ENABLE_TDRAUDIO
+    ,
+    output wire amp2_ain,
+    output wire amp2_gain,
+    output wire amp2_shutdown_n
+`endif
 );
 
     reg clk_1hz;
@@ -220,11 +225,44 @@ module top(
     assign uart_tx_data = mem_write_data[7:0];
     assign uart_rd_data = { {WIDTH-10{1'b1}}, uart_rx_avail, uart_tx_busy, uart_rx_data };
 
+    wire audio_irq;
+
+    buart #(.CLKFREQ(`clkfreq)) uart0(`clock, rst,
+        uart_baud,
+        uart_txd_in, uart_rxd_out,
+        uart_rx_clear, uart_tx_en,
+        uart_rx_avail, uart_tx_busy,
+        uart_tx_data, uart_rx_data);
+
+    // audio controller
+`ifdef ENABLE_TDRAUDIO
+    wire [WIDTH-1:0] tdraudio_wr_data;
+    wire [WIDTH-1:0] tdraudio_rd_data;
+    wire tdraudio_rd_en, tdraudio_wr_en;
+    wire tdraudio_irq;
+
+    wire tdraudio_cs_en = io_enable && (io_slot == 4);
+    assign tdraudio_rd_en = tdraudio_cs_en && mem_read_enable;
+    assign tdraudio_wr_en = tdraudio_cs_en && mem_write_enable;
+    assign tdraudio_wr_data = mem_write_data;
+
+    tdraudio tdraudio0(`clock, ~rst,
+        mem_addr[6:0],
+        tdraudio_rd_data,
+        tdraudio_wr_data,
+        tdraudio_rd_en,
+        tdraudio_wr_en,
+        tdraudio_irq,
+        amp2_ain, amp2_gain, amp2_shutdown_n);
+    assign audio_irq = tdraudio_irq;
+`endif
+
+    // interrupt controller
     reg timer_tick;
     reg[23:0] tick_count;
-    wire [1:0] irq_in = { timer_tick, uart_rx_avail };
+    wire [2:0] irq_in = { audio_irq, timer_tick, uart_rx_avail };
-    wire [1:0] irqc_rd_data0;
+    wire [2:0] irqc_rd_data0;
-    wire [WIDTH-1:0] irqc_rd_data = { tick_count, 6'b0, irqc_rd_data0 };
+    wire [WIDTH-1:0] irqc_rd_data = { tick_count, 5'b0, irqc_rd_data0 };
     wire irqc_seten = mem_write_data[7];
     wire irqc_cs = io_enable && (io_slot == 3);
 
@@ -236,16 +274,11 @@ module top(
                         (io_slot == 2) ? fb_rd_data :
     `endif
                         (io_slot == 3) ? irqc_rd_data:
-
+    `ifdef ENABLE_TDRAUDIO
+                        (io_slot == 4) ? tdraudio_rd_data:
+    `endif
                         -1;
 
-    buart #(.CLKFREQ(`clkfreq)) uart0(`clock, rst,
-        uart_baud,
-        uart_txd_in, uart_rxd_out,
-        uart_rx_clear, uart_tx_en,
-        uart_rx_avail, uart_tx_busy,
-        uart_tx_data, uart_rx_data);
-
      // CPU -----------------------------------------------------------------
     stackcpu cpu0(.clk(`clock), .rst(rst), .irq(irq),
         .addr(mem_addr),
@@ -253,7 +286,7 @@ module top(
         .read_ins(dram_read_ins),
         .data_out(mem_write_data), .write_enable(mem_write_enable),
         .mem_wait(mem_wait),
-        .led1(led1), .led2(led2), .led3(led3));
+        .debug1(led1), .debug2(led2), .debug3(led3));
 
     // Interrupt Controller
     irqctrl irqctrl0(`clock, irq_in, irqc_cs, mem_write_enable,

tridoracpu/tridoracpu.srcs/vgafb.v

@@ -6,8 +6,11 @@
 // Learn more at https://projectf.io
 
 //128K video memory is not enough for 640x480x4
-`define RES_640_400
+//`define RES_640_400
 //`define RES_1024_768
+// RES_640_480 mode displays 400 lines with 640x480/60 video timings,
+// adding blank lines at the bottom
+`define RES_640_480
 
 module display_timings #(
     H_RES=640,                      // horizontal resolution (pixels)
@@ -126,6 +129,8 @@ module vgafb #(VMEM_ADDR_WIDTH = 15, VMEM_DATA_WIDTH = 32) (
     localparam COLOR_WIDTH = 12;
     localparam PALETTE_WIDTH = 4;
 
+    localparam signed PIC_LINES = 400; // visible picture lines
+
     // Display Clocks
     wire pix_clk = CLK;                   // pixel clock
     wire clk_lock = 1;                  // clock locked?
@@ -202,6 +207,18 @@ module vgafb #(VMEM_ADDR_WIDTH = 15, VMEM_DATA_WIDTH = 32) (
         .V_BP(35),
         .H_POL(0),
         .V_POL(1)
+ `endif
+ `ifdef RES_640_480
+        .H_RES(640),               //     640      800     1280      1920
+        .V_RES(480),                //     480      600      720      1080
+        .H_FP(16),                 //      16       40      110        88
+        .H_SYNC(96),                //      96      128       40        44
+        .H_BP(48),                 //      48       88      220       148
+        .V_FP(10),                   //      10        1        5         4
+        .V_SYNC(2),                 //       2        4        5         5
+        .V_BP(33),                  //      33       23       20        36
+        .H_POL(0),                  //       0        1        1         1
+        .V_POL(0)                   //       0        1        1         1
  `endif
     )
     display_timings_inst (
@@ -217,6 +234,8 @@ module vgafb #(VMEM_ADDR_WIDTH = 15, VMEM_DATA_WIDTH = 32) (
         .o_sy(sy)
     );
 
+    wire pic_enable = (sy >= 0) && (sy < PIC_LINES);  // when to display pixels from VRAM
+
     wire [7:0] red;
     wire [7:0] green;
     wire [7:0] blue;
@@ -288,7 +307,7 @@ module vgafb #(VMEM_ADDR_WIDTH = 15, VMEM_DATA_WIDTH = 32) (
     // 12 bit RGB palette
     assign VGA_HS   = h_sync;
     assign VGA_VS   = v_sync;
-    assign VGA_R    = de ? color_data[11:8] : 4'b0;
+    assign VGA_R    = (pic_enable && de) ? color_data[11:8] : 4'b0;
-    assign VGA_G    = de ? color_data[7:4]  : 4'b0;
+    assign VGA_G    = (pic_enable && de) ? color_data[7:4]  : 4'b0;
-    assign VGA_B    = de ? color_data[3:0]  : 4'b0;
+    assign VGA_B    = (pic_enable && de) ? color_data[3:0]  : 4'b0;
 endmodule

tridoracpu/tridoracpu.xpr

@@ -4,7 +4,7 @@
 <!-- Copyright 1986-2022 Xilinx, Inc. All Rights Reserved.                   -->
 <!-- Copyright 2022-2025 Advanced Micro Devices, Inc. All Rights Reserved.   -->
 
-<Project Product="Vivado" Version="7" Minor="68" Path="C:/Users/sebastian/develop/Tridora-NexysA7/Tridora-CPU/tridoracpu/tridoracpu.xpr">
+<Project Product="Vivado" Version="7" Minor="68" Path="C:/Users/sebastian/develop/Tridora/tridoracpu/tridoracpu.xpr">
   <DefaultLaunch Dir="$PRUNDIR"/>
   <Configuration>
     <Option Name="Id" Val="ab60beb5e7ec4efc9a7b17699b9c3b13"/>
@@ -111,7 +111,7 @@
           <Attr Name="UsedIn" Val="implementation"/>
         </FileInfo>
       </File>
-      <File Path="$PSRCDIR/stack.v">
+      <File Path="$PSRCDIR/stack.v" Mode="RelativeOnly">
         <FileInfo>
           <Attr Name="UsedIn" Val="synthesis"/>
           <Attr Name="UsedIn" Val="implementation"/>
@@ -142,7 +142,7 @@
         </FileInfo>
       </File>
       <File Path="$PSRCDIR/testbench.v"/>
-      <File Path="$PPRDIR/rom.mem">
+      <File Path="$PPRDIR/rom.mem" Mode="RelativeOnly">
         <FileInfo>
           <Attr Name="UsedIn" Val="synthesis"/>
           <Attr Name="UsedIn" Val="simulation"/>
@@ -173,14 +173,14 @@
           <Attr Name="UsedIn" Val="simulation"/>
         </FileInfo>
       </File>
-      <File Path="$PSRCDIR/bram_tdp.v">
+      <File Path="$PSRCDIR/bram_tdp.v" Mode="RelativeOnly">
         <FileInfo>
           <Attr Name="UsedIn" Val="synthesis"/>
           <Attr Name="UsedIn" Val="implementation"/>
           <Attr Name="UsedIn" Val="simulation"/>
         </FileInfo>
       </File>
-      <File Path="$PSRCDIR/palette.v">
+      <File Path="$PSRCDIR/palette.v" Mode="RelativeOnly">
         <FileInfo>
           <Attr Name="UsedIn" Val="synthesis"/>
           <Attr Name="UsedIn" Val="implementation"/>
@@ -205,6 +205,13 @@
           <Attr Name="UsedIn" Val="simulation"/>
         </FileInfo>
       </File>
+      <File Path="$PSRCDIR/tdraudio.v">
+        <FileInfo>
+          <Attr Name="UsedIn" Val="synthesis"/>
+          <Attr Name="UsedIn" Val="implementation"/>
+          <Attr Name="UsedIn" Val="simulation"/>
+        </FileInfo>
+      </File>
       <Config>
         <Option Name="DesignMode" Val="RTL"/>
         <Option Name="TopModule" Val="top"/>
@@ -351,11 +358,13 @@
   <Runs Version="1" Minor="22">
     <Run Id="synth_1" Type="Ft3:Synth" SrcSet="sources_1" Part="xc7a35ticsg324-1L" ConstrsSet="constrs_1" Description="Vivado Synthesis Defaults" AutoIncrementalCheckpoint="false" WriteIncrSynthDcp="false" State="current" Dir="$PRUNDIR/synth_1" IncludeInArchive="true" IsChild="false" AutoIncrementalDir="$PSRCDIR/utils_1/imports/synth_1" AutoRQSDir="$PSRCDIR/utils_1/imports/synth_1" ParallelReportGen="true">
       <Strategy Version="1" Minor="2">
-        <StratHandle Name="Vivado Synthesis Defaults" Flow="Vivado Synthesis 2020"/>
+        <StratHandle Name="Vivado Synthesis Defaults" Flow="Vivado Synthesis 2024">
+          <Desc>Vivado Synthesis Defaults</Desc>
+        </StratHandle>
         <Step Id="synth_design"/>
       </Strategy>
       <GeneratedRun Dir="$PRUNDIR" File="gen_run.xml"/>
-      <ReportStrategy Name="Vivado Synthesis Default Reports" Flow="Vivado Synthesis 2020"/>
+      <ReportStrategy Name="Vivado Synthesis Default Reports" Flow="Vivado Synthesis 2024"/>
       <Report Name="ROUTE_DESIGN.REPORT_METHODOLOGY" Enabled="1"/>
       <RQSFiles/>
     </Run>
@@ -369,29 +378,25 @@
       <Report Name="ROUTE_DESIGN.REPORT_METHODOLOGY" Enabled="1"/>
       <RQSFiles/>
     </Run>
-    <Run Id="impl_1" Type="Ft2:EntireDesign" Part="xc7a35ticsg324-1L" ConstrsSet="constrs_1" Description="Increase placer effort in the post-placement optimization phase, and disable timing relaxation in the router." AutoIncrementalCheckpoint="false" WriteIncrSynthDcp="false" State="current" Dir="$PRUNDIR/impl_1" SynthRun="synth_1" IncludeInArchive="true" IsChild="false" GenFullBitstream="true" AutoIncrementalDir="$PSRCDIR/utils_1/imports/impl_1" LaunchOptions="-jobs 6 " AutoRQSDir="$PSRCDIR/utils_1/imports/impl_1" ParallelReportGen="true">
+    <Run Id="impl_1" Type="Ft2:EntireDesign" Part="xc7a35ticsg324-1L" ConstrsSet="constrs_1" Description="Default settings for Implementation." AutoIncrementalCheckpoint="false" WriteIncrSynthDcp="false" State="current" Dir="$PRUNDIR/impl_1" SynthRun="synth_1" IncludeInArchive="true" IsChild="false" GenFullBitstream="true" AutoIncrementalDir="$PSRCDIR/utils_1/imports/impl_1" LaunchOptions="-jobs 6 " AutoRQSDir="$PSRCDIR/utils_1/imports/impl_1" ParallelReportGen="true">
       <Strategy Version="1" Minor="2">
-        <StratHandle Name="Performance_RefinePlacement" Flow="Vivado Implementation 2020"/>
+        <StratHandle Name="Vivado Implementation Defaults" Flow="Vivado Implementation 2024">
+          <Desc>Default settings for Implementation.</Desc>
+        </StratHandle>
         <Step Id="init_design"/>
         <Step Id="opt_design"/>
         <Step Id="power_opt_design"/>
-        <Step Id="place_design">
+        <Step Id="place_design"/>
-          <Option Id="Directive">7</Option>
-        </Step>
         <Step Id="post_place_power_opt_design"/>
-        <Step Id="phys_opt_design">
+        <Step Id="phys_opt_design"/>
-          <Option Id="Directive">0</Option>
+        <Step Id="route_design"/>
-        </Step>
-        <Step Id="route_design">
-          <Option Id="Directive">0</Option>
-        </Step>
         <Step Id="post_route_phys_opt_design"/>
         <Step Id="write_bitstream">
           <Option Id="BinFile">1</Option>
         </Step>
       </Strategy>
       <GeneratedRun Dir="$PRUNDIR" File="gen_run.xml"/>
-      <ReportStrategy Name="Vivado Implementation Default Reports" Flow="Vivado Implementation 2020"/>
+      <ReportStrategy Name="Vivado Implementation Default Reports" Flow="Vivado Implementation 2024"/>
       <Report Name="ROUTE_DESIGN.REPORT_METHODOLOGY" Enabled="1"/>
       <RQSFiles/>
     </Run>

tridoraemu/README.md

@@ -5,7 +5,7 @@
 - written in Golang
 
 ## Getting started
-Download this zipfile: [tridoraemu.zip](https://git.insignificance.de/api/packages/slederer/generic/tridoraemu/0.0.1/tridoraemu.zip)
+Download this zipfile: [tridoraemu.zip](https://git.insignificance.de/api/packages/slederer/generic/tridoraemu/0.0.5/tridoraemu.zip)
 
 It contains the sources, the ROM image, an SD-card image and a precompiled windows binary.
 
@@ -40,7 +40,7 @@ On the ROM monitor prompt, press *B* to boot from the SD-card image. This should
 
 In the shell, try the *L* command to list directories and the *V* command to change volumes. The *Examples* volume contains some example programs in source form.
 
-The programs *lines*, *conway* and *mandelbrot*, among others, show some (hopefully) interesting VGA graphics. The *viewpict* program can show image files (*.pict files) which contain 640x400x4 bitmaps. A few sample image files are provided.
+The programs *lines*, *conway* and *mandelbrot*, among others, show some (hopefully) interesting VGA graphics. The *pictviewer* program can show image files (*.pict files) which contain 640x400x4 bitmaps. A few sample image files are provided.
 
 To compile a program, set the file name (e.g. *lines.pas*) with the *W* command in the shell. Then, use *B* and *R* to build and run the program.
 
@@ -50,6 +50,9 @@ The volume *Testvolume 1* (note the space) contains a precompiled game called *c
 
 You can run the program with the *O* command in the shell (just press Return for the program arguments), or you can set the workfile name with *W* and then use the *R* command.
 
+The volume *Rogue* contains a compiled version of ECL-Rogue, a Pascal variant of the
+classic Rogue game.
+
 The *K* command in the shell is used to reclaim the space occupied by deleted or overwritten files.
 
 A running program can be terminated by pressing Control-C, but only if the program is expecting keyboard input at that time.

tridoraemu/cpu.go

@@ -125,7 +125,7 @@ func (c *CPU) step() error {
 	
 	Y := c.estack[c.ESP]
 
-	insWord, err := c.mem.read(c.PC)
+	insWord, err := c.mem.readIns(c.PC)
 	if err != nil { return err }
 	if c.PC % 4 == 0 {
 		insWord = insWord >> 16

tridoraemu/mem.go

@@ -17,6 +17,12 @@ const IOSlotSize = 128
 
 const IOSlotCount = 16
 
+const DRAMStart = 65536
+
+const CacheAddrShift = 8
+
+const CacheWriteThrough = true
+
 type Mem struct {
 	ram [] word
 	iohandler [IOSlotCount] IOHandler
@@ -79,7 +85,7 @@ func (m *Mem) attachIO(h IOHandler, slot int) {
 	m.iohandler[slot] = h
 }
 
-func (m *Mem) read(byteaddr word) (word, error) {
+func (m *Mem) readRaw(byteaddr word) (word, error) {
 	if byteaddr >= IOStartAddr && byteaddr < RAMStartAddr {
 		ioslot := (byteaddr - IOStartAddr) / IOSlotSize
 		if m.iohandler[ioslot] != nil {
@@ -96,6 +102,14 @@ func (m *Mem) read(byteaddr word) (word, error) {
 	}
 }
 
+func (m *Mem) read(byteaddr word) (word, error) {
+	return m.readRaw(byteaddr);
+}
+
+func (m *Mem) readIns(byteaddr word) (word, error) {
+	return m.readRaw(byteaddr);
+}
+
 func (m *Mem) write(value word, byteaddr word) error {
 	if byteaddr < IOStartAddr {
 		return fmt.Errorf("Write to ROM area at %08X value %08X", byteaddr, value)

tridoraemu/tridoraemu.go

@@ -8,7 +8,8 @@ import (
 	"flag"
 	"time"
 	"github.com/hajimehoshi/ebiten/v2"
-	// "github.com/hajimehoshi/ebiten/v2/ebitenutil"
+	"github.com/hajimehoshi/ebiten/v2/ebitenutil"
+	"github.com/hajimehoshi/ebiten/v2/inpututil"
 	// "image/color"
 )
 
@@ -35,6 +36,7 @@ func idle(canGoIdle bool) {
 }
 
 type Game struct{
+		debug bool
 		x,y int
 		stepsPerFrame int
 		lastFrameDuration time.Duration
@@ -58,16 +60,23 @@ func (g *Game) Update() error {
 	}
 	g.lastFrameDuration = time.Since(startTime)
 
+	if inpututil.IsKeyJustReleased(ebiten.KeyF12) {
+		g.debug = !g.debug
+	}
+
 	return nil
 }
 
 func (g *Game) Draw(screen *ebiten.Image) {
 	screen.DrawImage(framebuffer.framebuffer, nil)
 
-	/*
+	if g.debug {
-	buf := fmt.Sprintf("PC: %08X FP: %08X RP: %08X ESP: %2X\n%v", cpu.PC, cpu.FP, cpu.RP, cpu.ESP, g.lastFrameDuration)
+		buf := fmt.Sprintf("PC: %08X FP: %08X RP: %08X ESP: %2X  %v",
-	ebitenutil.DebugPrint(screen, buf)
+			cpu.PC, cpu.FP, cpu.RP, cpu.ESP, g.lastFrameDuration)
+		ebitenutil.DebugPrint(screen, buf)
+	}
 
+	/*
 	screen.Set(g.x, g.y, color.RGBA{255,0,0,0})
 	screen.Set(g.x, g.y+1, color.RGBA{0,255,0,0})
 	screen.Set(g.x, g.y+2, color.RGBA{0,255,255,0})

utils/png2pict.py

@@ -2,6 +2,9 @@
 import sys
 import png
 
+sprite_width = 32
+sprite_height = 32
+
 def process_pixdata(outfile, pixdata, frameindex = 0, pix_w=640, pix_h=400):
 
     pixmask = 15
@@ -28,15 +31,22 @@ def process_pixdata(outfile, pixdata, frameindex = 0, pix_w=640, pix_h=400):
             x += 8
         y += 1
 
+def write_palette_word(outfile, r, g, b):
+    r4 = r >> 4
+    g4 = g >> 4
+    b4 = b >> 4
+    c12 = r4 << 8 | g4 << 4 | b4
+
+    outfile.write(c12.to_bytes(4, 'big'))
+
 
 def process_palette(outfile, palette):
-    for r,g,b in palette:
+    if len(palette[0]) == 4:
-        r4 = r >> 4
+        for r,g,b,a in palette:
-        g4 = g >> 4
+            write_palette_word(outfile, r, g, b)
-        b4 = b >> 4
+    else:
-        c12 = r4 << 8 | g4 << 4 | b4
+        for r,g,b in palette:
-
+            write_palette_word(outfile, r, g, b)
-        outfile.write(c12.to_bytes(4, 'big'))
 
 
 def write_header(outfile):
@@ -72,22 +82,20 @@ def write_pict_file(width, height, px, metadata, outfile):
 
 
 def write_sprite_file(width, height, px, metadata, outfile):
-    sprite_height=16
-
     print("processing as SPRT file with {} sprites...".format(height//sprite_height))
-    if width != 16:
+    if width != sprite_width:
-        print("width must be 16, aborting")
+        print("width must be {}, aborting".format(sprite_width))
         sys.exit(1)
     pixdata = list(px)
     palette = metadata['palette']
 
     if len(palette) != 16:
-        print("palette must have 16 colors, aborting")
+        print("palette must have 16 colors instead of {}, aborting".format(len(palette)))
         sys.exit(0)
 
     with open(outfile,'wb') as f:
         write_sprite_header(f)
-        process_pixdata(f, pixdata, pix_w=16, pix_h=height)
+        process_pixdata(f, pixdata, pix_w=sprite_width, pix_h=height)
 
 
 if __name__ == '__main__':
@@ -103,8 +111,8 @@ if __name__ == '__main__':
     width, height, px, metadata = p
     if width == 640:
         write_pict_file(width, height, px, metadata, outfile)
-    elif width == 16:
+    elif width == sprite_width:
         write_sprite_file(width, height, px, metadata, outfile)
     else:
-        print("Can't handle this file, need a width of\n640 or 16 pixels with 16 color palette.")
+        print("Can't handle this file, need a width of\n640 or {} pixels with 16 color palette.".format(sprite_width))
 

utils/serload.py

@@ -16,9 +16,12 @@
 # limitations under the License.
 
 import sys
+import os
 import serial
 import time
 import random
+import platform
+import argparse
 
 blocksize = 32
 BEL = 7
@@ -32,28 +35,11 @@ wordmask = 0xFFFFFFFF
 pattern = 0xAFFECAFE
 
 
-def serwrite_slow(databytes, ser):
+def get_default_device():
-    total = len(data)
+    if platform.system() == 'Windows':
-    count = 1
+        return 'COM4:'
-    for d in data:
+    else:
-        sys.stdout.write("writing {0:02x} {1:04d}/{2:04d}\r".format(ord(d), count, total))
+        return '/dev/ttyUSB1'
-        ser.write(bytes(d,"utf8"))
-        count += 1
-        time.sleep(0.020)
-    print()
-
-
-def serwrite(datafile, ser):
-    with open(datafile) as f:
-        data = f.read()
-        total = len(data)
-        count = 1
-        for d in data:
-            sys.stdout.write("writing {0:02x} {1:04d}/{2:04d}\r".format(ord(d), count, total))
-            ser.write(bytes(d,"utf8"))
-            count += 1
-            time.sleep(0.020)
-        print()
 
 
 def checksum(databytes):
@@ -76,10 +62,26 @@ def sendchar(char, ser):
     ser.write(char.to_bytes(1, 'big'))
 
 
-def sendcommand(ser, cmd=b'L'):
+def sendcommand(ser, cmd=b'L', verbose=False):
+    verbose = True
     ser.write(cmd)
     resp = ser.read_until()
-    print(cmd,"sent, response:", str(resp))
+    if verbose:
+        print(cmd,"sent, response:", str(resp))
+    return resp
+
+
+# send command and wait for echo
+def commandwait(ser, cmd):
+    resp = sendcommand(ser, cmd, verbose=False)
+    if len(resp) == 0:
+        print("timeout sending '{}' command".format(cmd))
+        return None
+
+    if resp != bytearray(cmd + b"\r\n"):
+        print("invalid response to '{}' command".format(cmd))
+        return None
+
     return resp
 
 
@@ -144,6 +146,8 @@ def serload_bin(datafile, ser):
 
         data += bytearray(pad)
 
+    print("{} total blocks".format((len(data) + blocksize - 1) // blocksize))
+
     if not send_size_header(ser, filesize):
         print("Error sending size header.")
         return
@@ -268,20 +272,122 @@ def serdownload(fname, ser):
         f.close()
 
 
+def mput(filenames, ser):
+    for f in filenames:
+        resp = set_filename(f, ser)
+        if resp is None:
+            return
+        serload_bin(f, ser)
+
+        resp = ser.read_until()
+
+        time.sleep(2)
+
+
+def set_filename(f, ser):
+    f_encoded = f.encode('utf8')
+    print("Setting filename", f)
+    resp = commandwait(ser, b'S')
+    if resp is None:
+        return None
+    resp = sendcommand(ser, f_encoded + b'\r')
+    if not f_encoded in resp:
+        print("unrecognized response to filename, aborting")
+        return None
+    return resp
+
+
+def getnamedfile(filename, ser):
+    resp = set_filename(filename, ser)
+    if resp is None:
+        return None
+    serdownload(filename, ser)
+
+
+def putnamedfile(filename, ser):
+    resp = set_filename(filename, ser)
+    if resp is None:
+        return None
+    serload_bin(filename, ser)
+    print("Remote status:")
+    showdata(ser)
+
+
+def showdata(ser):
+
+    promptseen = False
+
+    while not promptseen:
+        c = ser.read(1)
+        if c == b'>':
+            promptseen = True
+        else:
+            print(c.decode('utf8'), end='')
+    rest = ser.read(1)
+    
+
+def localdir():
+    result = os.walk(".")
+    for dirpath, dirnames, filenames in os.walk("."):
+        for f in filenames:
+            print(f)
+        break
+
+
+def interactive(ser):
+    done = False
+    while not done:
+        args = input("> ").strip().split()
+        if len(args) > 0:
+            cmd = args[0]
+            args.pop(0)
+            if cmd == 'dir':
+                if commandwait(ser, b'Y') is None:
+                    return
+                showdata(ser)
+            elif cmd == 'get':
+                if len(args) > 1:
+                    print("exactly one argument required (filename)")
+                else:
+                    getnamedfile(args[0], ser)
+            elif cmd == 'put':
+                if len(args) > 1:
+                    print("exactly one argument required (filename)")
+                else:
+                    putnamedfile(args[0], ser)
+            elif cmd == 'ldir':
+                if len(args) > 0:
+                    print("superfluous argument")
+                else:
+                    localdir()
+            else:
+                print("Unknown command. Valid commands are: dir get ldir put")
+                
+
 if __name__ == "__main__":
-    cmd = None
+    argparser = argparse.ArgumentParser(
-    if len(sys.argv) == 4:
+        description='transfer files from/to the Tridora-CPU')
-        cmd = sys.argv[1]
+    argparser.add_argument('-d', '--device', help='serial device', default=get_default_device())
-        filename = sys.argv[2]
+    argparser.add_argument('command', choices=['get', 'put', 'mput', 'interactive'])
-        serial_port = sys.argv[3]
+    argparser.add_argument('filename', nargs='*')
-        ser = serial.Serial(serial_port,115200, timeout=3)
+    args = argparser.parse_args()
+
+    cmd = args.command
+    serial_port = args.device
+    filenames = args.filename
+
+    ser = serial.Serial(serial_port,115200, timeout=3)
 
     if cmd == 'get':
-        serdownload(filename, ser)
+        serdownload(filenames[0], ser)
     elif cmd == 'put':
-        serload_bin(filename, ser)
+        serload_bin(filenames[0], ser)
+    elif cmd == 'mput':
+        mput(filenames, ser)
+    elif cmd == 'interactive':
+        interactive(ser)
     else:
-        print("Usage: {} get|put <filename> <serial device>".format(sys.argv[0]))
+        print("should not get here")
 
-    if cmd is not None:
+    #if cmd is not None:
-        ser.close()
+    #    ser.close()

utils/tdrimg.py

@@ -1,6 +1,6 @@
 #!/usr/bin/python3
 # vim: tabstop=8 expandtab shiftwidth=4 softtabstop=4
-# Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
+# Copyright 2021-2025 Sebastian Lederer. See the file LICENSE.md for details
 
 import struct
 import sys
@@ -372,6 +372,31 @@ def writetoimg(img, pathname, infilepath):
     putfile(infilepath, filename, img, vol, vol.startBlock, slotno)
 
 
+def initfs(f, partno):
+    part = getpartslot(f, partno)
+    partstart = part.startBlock
+    dir_slots = part.dirSize
+    extent_size = part.extentSize
+    slots_per_extent = extent_size // 64
+    reserved_slots = dir_slots // slots_per_extent
+
+    print()
+    print("Partition {} at {}".format(part.name, part.startBlock))
+
+    print("creating",reserved_slots, "reserved directory slots")
+    for a in range(0,reserved_slots):
+        d = createdirslot("DIR", SlotReserved, 0, 0, 0, 0, 0)
+        putdirslot(f, partstart, a, d)
+
+    print("creating", dir_slots - reserved_slots, "free slots")
+
+    for a in range(reserved_slots,  dir_slots):
+        d = createdirslot("", SlotFree, 0, 0, 0, 0, 0)
+        putdirslot(f, partstart, a, d)
+
+    return (part, partstart, reserved_slots)
+
+
 def create_image_with_stuff(imgfile):
     bootimage = "../lib/coreloader.prog"
     dir_slots = 256
@@ -381,22 +406,27 @@ def create_image_with_stuff(imgfile):
 
     f = open(imgfile,"w+b")
 
-    b = createpart("PHYS", PartPhysical, 0, 12288, 4096, 0, 0)
+    b = createpart("PHYS", PartPhysical, 0, 16384, 4096, 0, 0)
     #print(b)
     f.write(b)
 
     with open(bootimage, "rb") as bf:
         bootdata = bf.read()
     bootBlocks = len(bootdata) // 512 + 1
+
     b = createpart("BOOT", PartBoot, 16, 112, 0, 0, bootBlocks)
     f.write(b)
+
     b = createpart("Testvolume 1", PartEnabled, 128, 3968, 8192, 248)
     f.write(b)
 
     b = createpart("SYSTEM", PartEnabled, 4096, 4096, 8192, 256)
     f.write(b)
 
-    b = createpart("Examples", PartEnabled + PartLast, 8192, 4096, 8192, 256)
+    b = createpart("Examples", PartEnabled, 8192, 4096, 8192, 256)
+    f.write(b)
+
+    b = createpart("Rogue", PartEnabled + PartLast, 12288, 4096, 8192, 256)
     f.write(b)
 
     part = getpartslot(f, 2)
@@ -505,6 +535,11 @@ def create_image_with_stuff(imgfile):
     slotnr = putfile("../progs/editor.pas", None , f, part, partstart, slotnr)
     slotnr = putfile("../progs/editor.prog", None , f, part, partstart, slotnr)
     slotnr = putfile("../progs/xfer.prog", None , f, part, partstart, slotnr)
+    slotnr = putfile("../progs/recover.prog", None , f, part, partstart, slotnr)
+    slotnr = putfile("../progs/changemem.prog", None , f, part, partstart, slotnr)
+
+    slotnr = putfile("../lib/pcmaudio.s", None , f, part, partstart, slotnr)
+    slotnr = putfile("../lib/pcmaudio.inc", None , f, part, partstart, slotnr)
 
     listdir(f, part)
 
@@ -540,10 +575,10 @@ def create_image_with_stuff(imgfile):
     # slotnr = putfile("../tests/timetest.prog", None , f, part, partstart, slotnr)
 
     slotnr = putfile("../tests/readtest.pas", None , f, part, partstart, slotnr)
-    slotnr = putfile("../tests/readtest.prog", None , f, part, partstart, slotnr)
+    #slotnr = putfile("../tests/readtest.prog", None , f, part, partstart, slotnr)
 
     slotnr = putfile("../tests/readchartest.pas", None , f, part, partstart, slotnr)
-    slotnr = putfile("../tests/readchartest.prog", None , f, part, partstart, slotnr)
+    #slotnr = putfile("../tests/readchartest.prog", None , f, part, partstart, slotnr)
 
     # slotnr = putfile("cchangetest.pas", None , f, part, partstart, slotnr)
     # slotnr = putfile("cchangetest.prog", None , f, part, partstart, slotnr)
@@ -553,16 +588,13 @@ def create_image_with_stuff(imgfile):
     slotnr = putfile("../tests/test133.pas", None , f, part, partstart, slotnr)
     # slotnr = putfile("../tests/test133.prog", None , f, part, partstart, slotnr)
 
-    slotnr = putfile("../tests/test159.pas", None , f, part, partstart, slotnr)
+    # slotnr = putfile("../tests/test159.pas", None , f, part, partstart, slotnr)
     # slotnr = putfile("../tests/test159.prog", None , f, part, partstart, slotnr)
 
     slotnr = putfile("../tests/umlaut.pas", None , f, part, partstart, slotnr)
 
     slotnr = putfile("../examples/rtpair.pas", None , f, part, partstart, slotnr)
 
-    slotnr = putfile("../examples/5cubes.pas", None , f, part, partstart, slotnr)
-    # slotnr = putfile("../examples/5cubes.prog", None , f, part, partstart, slotnr)
-
     slotnr = putfile("../examples/3dcube.pas", None , f, part, partstart, slotnr)
 
     slotnr = putfile("../examples/conway.pas", None , f, part, partstart, slotnr)
@@ -571,14 +603,30 @@ def create_image_with_stuff(imgfile):
 
     slotnr = putfile("../examples/lines.pas", None , f, part, partstart, slotnr)
 
+    slotnr = putfile("../examples/pcmtest2.pas", None , f, part, partstart, slotnr)
+
     slotnr = putfile("../examples/pictviewer.pas", None , f, part, partstart, slotnr)
-    # slotnr = putfile("viewpict.prog", None , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/Toco_Toucan.pict", None , f, part, partstart, slotnr)
-    slotnr = putfile("../examples/ara.pict", "ara.pict" , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/shinkansen.pict", None , f, part, partstart, slotnr)
-    slotnr = putfile("../examples/shinkansen.pict", "shinkansen.pict" , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/snow_leopard.pict", None , f, part, partstart, slotnr)
-    slotnr = putfile("../examples/snow_leopard.pict", "snow_leopard.pict" , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/ADDS-Envoy-620.pict", None , f, part, partstart, slotnr)
 
     slotnr = putfile("../examples/benchmarks.pas", None , f, part, partstart, slotnr)
 
+    slotnr = putfile("../examples/animate.pas", None , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/sprites.inc", None , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/sprites.s", None , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/background.pict", None , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/walking.sprt", None , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/rocket.sprt", None , f, part, partstart, slotnr)
+
+    listdir(f, part)
+
+    part, partstart, slotnr = initfs(f, 5)
+    slotnr = putfile("../rogue/rogue.init", None, f, part, partstart, slotnr)
+    slotnr = putfile("../rogue/rogue.message", None, f, part, partstart, slotnr)
+    slotnr = putfile("../rogue/rogue.prog", None, f, part, partstart, slotnr)
+
     listdir(f, part)
 
     write_bootimage(f, 16, bootdata)

utils/wav2tdrau.py

@@ -0,0 +1,29 @@
+import sys
+import random, struct
+import wave
+
+freq = 16000
+BIAS = 32768
+def convert(srcpath, destpath):
+	outdata = bytearray()
+	with wave.open(srcpath, mode="rb") as f:
+		params = f.getparams()
+		print(params.nchannels, params.sampwidth, params.framerate)
+
+		frames = f.readframes(2*1024*1024)
+		for i in range(0, len(frames), 2):
+			v = int.from_bytes(frames[i:i+2], "little", signed=True)
+			v += BIAS
+			hi = (v & 0xFF00) >> 8
+			lo = (v & 0x00FF)
+			outdata.append(hi)
+			outdata.append(lo)
+
+	with open(destpath, mode="wb") as f:
+		f.write(outdata)
+
+
+if __name__ == "__main__":
+	sourcefilename = sys.argv[1]
+	destfilename = sys.argv[2]
+	convert(sourcefilename, destfilename)