tridoracpu: cleaned up top a bit, removed some warnings

xfer: reset block count on transfer start

.gitignore

@@ -5,6 +5,7 @@ tests/*.s
 examples/*.s
 !runtime.s
 !stdlibwrap.s
+!sprites.s
 *.o
 *.exe
 *.bin
@@ -25,6 +26,7 @@ graph1.pas
 graph2.pas
 chase.pas
 pcomp/libgen
+pcomp/shortgen
 pcomp/lsymgen
 pcomp/pcomp
 pcomp/sasm
@@ -32,16 +34,18 @@ pcomp/sdis
 tridoraemu/tridoraemu
 **/tridoracpu.cache/
 **/tridoracpu.hw/
+**/tridoracpu.gen/
 **/tridoracpu.ip_user_files/
 **/tridoracpu.runs/
 *.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.2/files/8) (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.2/files/7)
+- 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

@@ -44,7 +44,7 @@ var a:array [1..3] of integer;
 
 	...
 
-	a[1] := 3; a[3] := 2; a[5] := 1; 
+	a[1] := 3; a[2] := 2; a[3] := 1;
 
 	for i in a do
 		writeln(i);
@@ -66,7 +66,7 @@ var c:char;
 ```
 
 In Tridora Pascal, this syntax also works because `[ 'y', 'n' ]` will not be treated as a set literal, but as an array literal.
-The _in_ operator also works for linear arrays, so the _if_ statement will have the same result.
+The _in_ operator also works for linear arrays, so the above _if_ statement will have the same result.
 
 Note that the array _in_ operator will be more inefficient for larger ranges (i.e. `'A'..'z'`), but more efficient for sparse sets (i.e. `'A','z'`).
 
@@ -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.
 
@@ -123,7 +133,7 @@ The implementation also has the following properties:
 - _read_/_write_ do ASCII conversion on scalar variables, records and arrays are processed as binary
 - enums and booleans are treated as integers
 - _readln_/_writeln_ operate as expected, that is, they perform _read_/_write_ and then wait for/write a newline sequence
-- other file operations available are _eof_, _eoln_ and _seek_
+- other file operations available are _eof_, _eoln_, _seek_ and _filepos_
 - for error handling there is a function _IOResult_
 - terminating the program without calling _close_ on open files will lose data
 
@@ -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/3dplot.pas

@@ -0,0 +1,97 @@
+program threedeeplot;
+const w = 640;
+      h = 400;
+
+var u0,v0:integer;
+
+function fun(x0,y0:real):real;
+const vscale = 50.0;
+      hscale = 20.0;
+
+var x,y,f:real;
+begin
+	x := x0 / hscale;
+	y := y0 / hscale;
+	f := sin(sqrt(x*x + y*y));
+
+	fun := f * vscale;
+end;
+
+procedure plot;
+var maxV,minV:array [0..w] of real;
+    shift:integer;
+    x,y,z:integer;
+    lastZ:integer;
+    numLines:integer;
+    i:integer;
+    u,v,lastU,lastV:integer;
+    color:integer;
+
+  procedure resetCurve;
+  begin
+  	lastU := -1;
+  	lastV := -1;
+  end;
+
+begin
+	for i := 0 to w do
+	begin
+		maxV[i] := -10000;
+		minV[i] :=  10000;
+	end;
+
+	color := 1;
+	shift := 4;
+	x := 0;
+	numLines := 80;
+	u0 := w div 2;
+	v0 := h div 2;
+
+	for i := -(numLines div 2) to numLines do
+	begin
+		resetCurve;
+		x := i * (w div numLines);
+		for y := -w to w do
+		begin
+			z := round(fun(x,y));
+			u := round(y + u0 + i * shift);
+			v := round(-z + v0 - i * shift);
+
+			if (u >= 0) and (u < w) then
+			begin
+				if (v < maxV[u]) and (v > minV[u]) then
+					resetCurve
+				else
+				begin	
+					if (u >= 0) and (u < w) and (v > maxV[u]) then
+						maxV[u] := v;
+					if (u >= 0) and (u < w) and (v < minV[u]) then
+						minV[u] := v;
+
+					if lastZ < z then
+						color := 8
+					else
+						color := 1;
+
+					if (u >= w) or (u < 0) or (v >= h) or (v < 0) then
+						resetCurve
+					else
+					begin				
+						if lastU = -1 then
+							putpixel(u,v,color)
+						else
+							drawline(lastU,lastV,u,v,color);
+					end;
+					lastU := u;
+					lastV := v;
+					lastZ := z;
+				end;
+			end;
+		end;
+	end;
+end;
+
+begin
+	initgraphics;
+	plot;
+end.

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.pas

@@ -0,0 +1,299 @@
+{$H350}
+program benchmarks;
+var starttime:DateTime;
+    endtime:DateTime;
+
+procedure startBench(name:string);
+begin
+	write(name:35, ' ');
+	starttime := GetTime;
+end;
+
+procedure endBench;
+var secDelta, minDelta, hourDelta:integer;
+  procedure write2Digits(i:integer);
+  begin
+  	if i < 10 then
+  		write('0');
+  	write(i);
+  end;
+begin
+	endtime := GetTime;
+
+	hourDelta := endtime.hours - starttime.hours;
+	minDelta  := endtime.minutes - starttime.minutes;
+	secDelta  := endtime.seconds - starttime.seconds;
+
+	if secDelta < 0 then
+	begin
+		secDelta := 60 + secDelta;
+		minDelta := minDelta - 1;
+	end;
+
+	if minDelta < 0 then
+	begin
+		minDelta := 60 + minDelta;
+		hourDelta := hourDelta - 1;
+	end;
+
+	write2Digits(hourDelta);
+	write(':');
+	write2Digits(minDelta);
+	write(':');
+	write2Digits(secDelta);
+	writeln;
+end;
+
+procedure bench0;
+var i:integer;
+begin
+	startBench('empty loop 10M');
+	for i := 1 to 10000000 do;
+	endBench;
+end;
+
+procedure bench1;
+var i:integer;
+    v:integer;
+begin
+	startBench('write variable 10M');
+	for i := 1 to 10000000 do
+		v := 0;
+	endBench;
+end;
+
+procedure bench2;
+var i:integer;
+    v,r:integer;
+begin
+	v := 4711;
+	startBench('read variable 10M');
+	for i := 1 to 10000000 do
+		r := v;
+	endBench;
+end;
+
+procedure bench3;
+var i:integer;
+    a,b:integer;
+begin
+	a := 0;
+	b := 100;
+
+	startBench('integer addition 10M');
+	for i := 1 to 10000000 do
+		a := b + i;
+	endBench;	
+end;
+
+procedure bench4;
+var i:integer;
+    a,b:real;
+begin
+	a := 0.0;
+	b := 100.0;
+
+	startBench('real addition 1M');
+	for i := 1 to 1000000 do
+		a := b + i;
+	endBench;
+end;
+
+procedure bench5;
+var i:integer;
+    a,b:integer;
+begin
+	a := 0;
+	b := 100;
+
+	startBench('integer multiplication 1M');
+	for i := 1 to 1000000 do
+		a := b * i;
+	endBench;	
+end;
+
+procedure bench6;
+var i:integer;
+    a,b:real;
+begin
+	a := 0;
+	b := 100;
+
+	startBench('real multiplication 1M');
+	for i := 1 to 1000000 do
+		a := b * i;
+	endBench;
+end;
+
+procedure bench7;
+var i:integer;
+    a,b:integer;
+begin
+	a := 0;
+	b := 31415926;
+
+	startBench('integer division 1M');
+	for i := 1 to 1000000 do
+		a := b div i;
+	endBench;
+end;
+
+procedure bench8;
+var i:integer;
+    a,b,c:real;
+begin
+	a := 0;
+	b := 31415926.0;
+
+	startBench('real division 1M');
+	for i := 1 to 1000000 do
+		a := b / i;
+	endBench;
+end;
+
+procedure bench9;
+var i,j:integer;
+    s:string[100];
+    c:char;
+begin
+	s := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn';
+
+	startBench('string indexing 1M');
+	for i := 1 to 100000 do
+		for j := 1 to 100 do
+			c := s[j];
+	endBench;
+end;
+
+procedure bench10;
+var i:integer;
+    s:string[100];
+    c,d:char;
+begin
+	s := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn';
+
+	startBench('string iteration 1M');
+	for i := 1 to 100000 do
+		for c in s do
+			d := c;
+	endBench;
+end;
+
+procedure bench11;
+var ptr: ^array[0..255] of integer;
+    dummy1,dummy2,dummy3: ^array[0..127] of boolean;
+    i:integer;
+begin
+	new(dummy1);
+	new(dummy2);
+	new(dummy3);
+	dispose(dummy1);
+
+	startBench('new/dispose 1k 1M');
+	for i := 1 to 1000000 do
+	begin
+		new(ptr);
+		dispose(ptr);
+	end;
+	endBench;
+
+	dispose(dummy2);
+	dispose(dummy3);
+end;
+
+procedure bench12;
+var ptr: ^array[0..32767] of integer;
+    dummy1,dummy2,dummy3: ^array[0..127] of boolean;
+    i:integer;
+begin
+	new(dummy1);
+	new(dummy2);
+	new(dummy3);
+	dispose(dummy1);
+
+	startBench('new/dispose 128k 1M');
+	for i := 1 to 1000000 do
+	begin
+		new(ptr);
+		dispose(ptr);
+	end;
+	endBench;
+
+	dispose(dummy2);
+	dispose(dummy3);
+end;
+
+procedure bench13;
+var ptr1: ^array[0..255] of integer;
+    ptr2: ^array[0..255] of integer;
+    i:integer;
+begin
+	new(ptr1);
+	new(ptr2);
+	startBench('array copy 1k 10K');
+	for i := 1 to 10000 do
+		ptr1^ := ptr2^;
+	endBench;
+	dispose(ptr1);
+	dispose(ptr2);
+end;
+
+procedure bench14;
+var ptr1: ^array[0..32767] of integer;
+    ptr2: ^array[0..32767] of integer;
+    i:integer;
+begin
+	new(ptr1);
+	new(ptr2);
+	startBench('array copy 128k 1K');
+	for i := 1 to 1000 do
+		ptr1^ := ptr2^;
+	endBench;
+	dispose(ptr1);
+	dispose(ptr2);
+end;
+
+procedure bench15;
+var i,j:integer;
+    a:real;
+begin
+	startBench('exp() 10K');
+	for i := 1 to 1000 do
+		for j := 1 to 10 do
+			a := exp(j);
+	endBench;
+end;
+
+procedure bench16;
+var i,j:integer;
+    a,b:real;
+begin
+	startBench('cos() 10K');
+	b := 0.0;
+	for i := 1 to 10000 do
+	begin
+		a := cos(b);
+		b := b + 0.0001;
+	end;
+	endBench;
+end;
+
+begin
+	bench0;
+	bench1;
+	bench2;
+	bench3;
+	bench4;
+	bench5;
+	bench6;
+	bench7;
+	bench8;
+	bench9;
+	bench10;
+	bench11;
+	bench12;
+	bench13;
+	bench14;
+	bench15;
+	bench16;
+end.

examples/benchmarks.results.text

@@ -0,0 +1,196 @@
+------------------------
+Arty-A7-35T
+83MHz, 64KB SRAM, 256MB DRAM
+
+Running benchmarks.prog
+                     empty loop 10M 00:00:09
+                 write variable 10M 00:00:10
+                  read variable 10M 00:00:12
+               integer addition 10M 00:00:16
+                   real addition 1M 00:00:27
+          integer multiplication 1M 00:01:07
+             real multiplication 1M 00:00:58
+                integer division 1M 00:01:44
+                   real division 1M 00:01:06
+                 string indexing 1M 00:00:27
+                string iteration 1M 00:00:11
+                  new/dispose 1k 1M 00:00:19
+                new/dispose 128k 1M 00:00:19
+                  array copy 1k 10K 00:00:02
+                 array copy 128k 1K 00:00:44
+                          exp() 10K 00:00:29
+                          cos() 10K 00:00:06
+
+--------------------------------------
+Arty-A7-35T
+83MHz, 64KB SRAM, 256MB DRAM
+running in DRAM (except corelib, stdlib, runtime)
+
+Running benchmarks.prog
+                     empty loop 10M 00:00:30
+                 write variable 10M 00:00:37
+                  read variable 10M 00:00:40
+               integer addition 10M 00:00:48
+                   real addition 1M 00:00:31
+          integer multiplication 1M 00:01:11
+             real multiplication 1M 00:01:03
+                integer division 1M 00:01:48
+                   real division 1M 00:01:11
+                 string indexing 1M 00:01:13
+                string iteration 1M 00:00:47
+                  new/dispose 1k 1M 00:00:27
+                new/dispose 128k 1M 00:00:27
+                  array copy 1k 10K 00:00:03
+                 array copy 128k 1K 00:00:44
+                          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)
+
+Running benchmarks.prog
+                     empty loop 10M 00:00:32
+                 write variable 10M 00:00:40
+                  read variable 10M 00:00:43
+               integer addition 10M 00:00:52
+                   real addition 1M 00:00:34
+          integer multiplication 1M 00:01:17
+             real multiplication 1M 00:01:08
+                integer division 1M 00:01:57
+                   real division 1M 00:01:17
+                 string indexing 1M 00:01:19
+                string iteration 1M 00:00:51
+                  new/dispose 1k 1M 00:00:29
+                new/dispose 128k 1M 00:00:30
+                  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
+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

@@ -1,4 +1,4 @@
-program viewpict;
+program pictviewer;
 type PictData = record
 		magic, mode:integer;
 		palette: array [0..15] of integer;
@@ -40,5 +40,4 @@ begin
 
 	loadPalette(pic);
 	loadPic(pic);
-	read(ch);
 end.

examples/sprites.inc

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

examples/sprites.s

@@ -0,0 +1,388 @@
+	.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
+        .EQU FB_WA      $901
+        .EQU FB_IO      $902
+        .EQU FB_PS      $903
+
+; calculate mask for a word of pixels
+; args: word of pixels with four bits per pixel
+; returns: value that masks out all pixels that are set
+CALC_MASK:
+	LOADC $F	; pixel mask
+C_M_L0:
+	SWAP		; swap mask and pixels value
+	AND.S1.X2Y	; isolate one pixel, keep args
+	CBRANCH.Z C_M_L1 ; if pixel is zero, dont set mask bits
+	OVER		; copy current mask
+	OR		; or into pixels value
+C_M_L1:
+	SWAP 		; swap back, ToS is now mask bits
+	SHL 2		; shift mask for next pixel to the left
+	SHL 2
+
+	DUP
+	CBRANCH.NZ C_M_L0 ; if mask is zero, we are done
+	DROP		; remove mask bits
+	NOT		; invert result	
+	RET
+
+; calculate vmem address from coordinates
+; args: x,y
+; returns: vmem word number
+CALC_VMEM_ADDR:
+	; only works if WORDS_PER_LINE is 80
+	; and pixels per word is 8
+	
+	DUP
+			; y
+	SHL 2
+	SHL 2
+	SHL 2		;   * 64
+	
+	SWAP
+			; + y
+	SHL 2
+	SHL 2		;     * 16
+	ADD
+
+	SWAP
+			; word offset = X/8
+	SHR
+	SHR
+	SHR
+	ADD
+
+	RET
+
+; put a sprite on screen
+; arg: x,y pointer to sprite data
+	.EQU PS_VMEM_ADDR	0
+	.EQU PS_SPRITE_DATA	4
+	.EQU PS_SPRITE_LINES	8
+	.EQU PS_X		12
+	.EQU PS_Y		16
+	.EQU PS_SHIFT_C		20
+	.EQU PS_SPILL		24
+	.EQU PS_STRIPE_C	28
+	.EQU PS_FS 32
+PUTSPRITE:
+	FPADJ -PS_FS
+	STORE PS_SPRITE_DATA
+	STORE PS_Y
+	STORE PS_X
+
+	; calculate vmem address
+	LOAD PS_X
+	LOAD PS_Y
+	LOADCP CALC_VMEM_ADDR
+	CALL	
+	STORE PS_VMEM_ADDR
+
+	LOAD PS_X	; shift count = x mod 8
+	LOADC 7
+	AND
+	STORE PS_SHIFT_C
+
+	LOADC SPRITE_HEIGHT
+	STORE PS_SPRITE_LINES
+
+	; loop over each line of the sprite
+PS_LOOP1:
+	; set read and write address
+	; in the vga controller
+	LOADC FB_RA ; read address register
+	LOAD PS_VMEM_ADDR
+	STOREI 1 ; use autoincrement to get to the next register
+	LOAD PS_VMEM_ADDR
+	STOREI
+	DROP
+
+	LOAD PS_SPRITE_DATA	; address of sprite data
+	DUP
+	INC 4			; increment pointer
+	STORE PS_SPRITE_DATA	; and store it again
+	LOADI			; load word from orig. address
+
+
+	LOADC 0
+	STORE PS_SPILL
+
+	; loop to shift pixel data to right
+	LOAD PS_SHIFT_C		; load shift count
+PS_LOOP2:
+	DUP			; test it for zero
+	CBRANCH.Z PS_LOOP2_X
+
+	SWAP			; swap count with pixels
+
+	; save the pixel that is shifted out
+	LOADC $F		; mask the four bits
+	AND.S0			; keep original value on stack
+	BROT			; and move them to MSB
+	BROT
+	BROT
+	SHL 2
+	SHL 2			; shift by 28 in total
+
+	LOAD PS_SPILL		; load spill bits
+	SHR			; shift by four to make space
+	SHR
+	SHR
+	SHR
+	OR			; or with orig value
+	STORE PS_SPILL		; store new value
+
+	SHR			; shift pixels right
+	SHR			; four bits per pixel
+	SHR
+	SHR
+
+	SWAP			; swap back, count now ToS
+	DEC 1
+	BRANCH PS_LOOP2
+PS_LOOP2_X:
+	DROP			; remove shift count, shifted pixels now in ToS
+
+	DUP
+	LOADCP CALC_MASK	; calculate sprite mask for this word
+	CALL
+
+	LOADCP FB_IO		; address of the i/o register
+	LOADI			; read word from video mem
+
+	AND			; and word with mask
+	
+	OR			; OR sprite data with original pixels
+
+	LOADCP FB_IO
+	SWAP
+	STOREI			; store result into i/o reg
+	DROP
+
+	; set counter for remaining stripes
+	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
+
+	LOAD PS_SPRITE_DATA	; address of sprite data
+	DUP
+	INC 4			; increment pointer
+	STORE PS_SPRITE_DATA	; and store it again
+	LOADI			; load word from orig. address
+
+	; 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
+	DUP
+	CBRANCH.Z PS_LOOP3_X
+
+	SWAP			; swap count with pixels
+
+	; save the pixel that is shifted out
+	LOADC $F		; mask the four bits
+	AND.S0			; keep original value on stack
+	BROT			; and move them to MSB
+	BROT
+	BROT
+	SHL 2
+	SHL 2			; shift by 28 in total
+
+	LOAD PS_SPILL		; load spill bits
+	SHR			; shift by four to make space
+	SHR
+	SHR
+	SHR
+	OR			; or with orig value
+	STORE PS_SPILL		; store new value
+
+	SHR			; shift pixels right
+	SHR			; four bits per pixel
+	SHR
+	SHR
+
+	SWAP			; swap back, count now ToS
+	DEC 1
+	BRANCH PS_LOOP3
+PS_LOOP3_X:
+	DROP			; remove shift count, shifted pixels now in ToS
+
+	OR			; or together with spill bits
+
+	DUP
+	LOADCP CALC_MASK	; calculate sprite mask
+	CALL
+
+	LOADCP FB_IO		; load original pixels
+	LOADI
+
+	AND			; and with mask
+
+	OR			; or together with original pixels
+
+	LOADCP FB_IO
+	SWAP
+	STOREI
+	DROP
+
+	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
+	CALL
+
+	LOADCP FB_IO
+	LOADI			; load next vmem word
+	AND			; apply sprite mask
+	
+	OR			; OR in spill bits
+
+	LOADCP FB_IO
+	SWAP			; swap pixels and addr
+	STOREI			; write back
+	DROP
+		
+	LOAD PS_SPRITE_LINES	; decrement lines count
+	DEC 1
+	DUP
+	CBRANCH.Z PS_L_XT	; exit if zero
+	STORE PS_SPRITE_LINES
+				; prepare next line
+	LOAD PS_VMEM_ADDR
+	LOADC WORDS_PER_LINE	; increment to next screen line
+	ADD
+	STORE PS_VMEM_ADDR
+	BRANCH PS_LOOP1
+PS_L_XT:
+	DROP
+			
+	FPADJ PS_FS
+	RET
+
+; undraw a sprite, i.e. draw background data
+; over a sprite location
+; args: x,y, ptr to background data
+	.EQU UD_S_X 0
+	.EQU UD_S_Y 4
+	.EQU UD_S_PXS 8
+	.EQU UD_S_BGDATA 12
+	.EQU UD_S_OFFSET 16
+	.EQU UD_S_BGORIG 20
+	.EQU UD_STRIPE_C 24
+	.EQU UD_S_FS 28
+UNDRAWSPRITE:
+	FPADJ -UD_S_FS
+	STORE UD_S_BGORIG
+	STORE UD_S_Y
+	STORE UD_S_X
+
+	; calculate pixel shift
+	LOAD UD_S_X
+	LOADC $7
+	AND
+	STORE UD_S_PXS
+
+	; calculate vmem offset
+	LOAD UD_S_X
+	LOAD UD_S_Y
+	LOADCP CALC_VMEM_ADDR
+	CALL
+
+	DUP
+	STORE UD_S_OFFSET
+
+	; calculate background data address from offset
+	SHL 2
+	LOAD UD_S_BGORIG
+	ADD
+	STORE UD_S_BGDATA
+
+	LOADC SPRITE_HEIGHT	; line count
+UD_S_L1:
+	; store vmem offset into write addr reg
+	LOADCP FB_WA
+	LOAD UD_S_OFFSET
+	STOREI 1	; ugly but fast: reuse addr
+			; with postincrement to
+			; get to FB_IO for STOREI below
+
+	; load a word of background data
+	LOAD UD_S_BGDATA
+	LOADI
+	; and write it to vmem
+	STOREI
+	; reuse addr from STOREI
+
+	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
+	; reuse addr from STOREI
+
+	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 next word of background data
+	LOADCP FB_IO
+	LOAD UD_S_BGDATA
+	INC 4
+	LOADI
+	STOREI ; and write it to vmem
+	DROP
+
+UD_S_L2:
+	LOAD UD_S_OFFSET
+	LOADCP WORDS_PER_LINE
+	ADD
+	DUP
+	STORE UD_S_OFFSET
+	SHL 2
+	LOAD UD_S_BGORIG
+	ADD
+	STORE UD_S_BGDATA	
+
+	DEC 1	; decrement counter
+	DUP
+	CBRANCH.NZ UD_S_L1 ; check for zero
+
+	DROP	; remove counter
+		
+	FPADJ UD_S_FS
+	RET
+

examples/xmas.pas

@@ -0,0 +1,224 @@
+(* 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;
+
+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;
+    santaSprite: Sprite;
+    deerSprite: Sprite;
+    ohDeerSprite: Sprite;
+    rudolfSprite: Sprite;
+    smokeSprite: 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 * 128);
+	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;
+
+		if frameIndex = 1 then
+		begin
+			ydelta := - ydelta;
+			aSprite.ydelta := ydelta;
+		end;
+		aSprite.y := aSprite.y + ydelta;
+	end;
+
+	aSprite.frameLeft := frameLeft;
+
+	aSprite.x := aSprite.x + aSprite.xdelta;
+	if aSprite.x > 620 then aSprite.x := 0;	
+end;
+
+procedure animate;
+var i:integer;
+    ydelta:integer;
+    frameIndex:integer;
+    frameTime:integer;
+    oldX,oldY:integer;
+begin
+	santaSprite.x := 0;
+	santaSprite.y := 60;
+	santaSprite.frameTime := 10;
+	santaSprite.xdelta := 2;
+	santaSprite.ydelta := 1;
+
+	smokeSprite.x := 434;
+	smokeSprite.y := 252;
+	smokeSprite.frameTime := 20;
+
+	deerSprite.x := 18;
+	deerSprite.y := 60;
+	deerSprite.frameTime := 10;
+	deerSprite.xdelta := 2;
+	deerSprite.ydelta := 1;
+
+	ohDeerSprite.x := 33;
+	ohDeerSprite.y := 61;
+	ohDeerSprite.frameTime := 10;
+	ohDeerSprite.xdelta := 2;
+	ohDeerSprite.ydelta := 1;
+
+	rudolfSprite.x := 49;
+	rudolfSprite.y := 60;
+	rudolfSprite.frameTime := 10;
+	rudolfSprite.xdelta := 2;
+	rudolfSprite.ydelta := 1;
+
+	ydelta := 1;
+
+	frameTime := santaSprite.frameTime;
+
+	while not ConAvail do
+	begin
+		frameIndex := santaSprite.curFrame;
+		oldX := santaSprite.x; oldY := santaSprite.y;
+		PutSprite(oldX, oldY, santaSprite.frame[frameIndex]);
+		i := i + 1;
+		frameTime := frameTime - 1;
+		if frameTime = 0 then
+		begin
+			frameTime := santaSprite.frameTime;
+			santaSprite.curFrame := frameIndex + 1;
+			if frameIndex >= santaSprite.frameCount
+			then
+				santaSprite.curFrame := 0;
+
+			if frameIndex = 0 then ydelta := - ydelta;
+			santaSprite.y := santaSprite.y + ydelta;
+		end;
+		santaSprite.x := santaSprite.x + 2;
+		if santaSprite.x > 620 then santaSprite.x := 0;
+
+		PutSprite(deerSprite.x, deerSprite.y,
+			deerSprite.frame[deerSprite.curFrame]);
+
+		PutSprite(ohDeerSprite.x, ohDeerSprite.y,
+			ohDeerSprite.frame[ohDeerSprite.curFrame]);
+
+		PutSprite(rudolfSprite.x, rudolfSprite.y,
+			rudolfSprite.frame[rudolfSprite.curFrame]);
+
+		PutSprite(smokeSprite.x, smokeSprite.y,
+			smokeSprite.frame[smokeSprite.curFrame]);
+
+		animateSprite(deerSprite);
+		animateSprite(ohDeerSprite);
+		animateSprite(rudolfSprite);
+		animateSprite(smokeSprite);
+
+		Delay(10);
+		WaitVSync;
+
+		UndrawSprite(oldX, oldY, pic.pixeldata);
+		UndrawSprite(deerSprite.oldX, deerSprite.oldY, pic.pixeldata);
+		UndrawSprite(ohDeerSprite.oldX, ohDeerSprite.oldY, pic.pixeldata);
+		UndrawSprite(rudolfSprite.oldX, rudolfSprite.oldY, pic.pixeldata);
+		UndrawSprite(smokeSprite.oldX, smokeSprite.oldY, 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, 'sprites.sprt', ModeReadOnly);
+	loadSpriteFrame(santaSprite, 0, infile, 0);
+	loadSpriteFrame(santaSprite, 1, infile, 1);
+
+	loadSpriteFrame(deerSprite, 0, infile, 5);
+	loadSpriteFrame(deerSprite, 1, infile, 6);
+	loadSpriteFrame(deerSprite, 2, infile, 7);
+
+	loadSpriteFrame(ohDeerSprite, 0, infile, 7);
+	loadSpriteFrame(ohDeerSprite, 1, infile, 5);
+	loadSpriteFrame(ohDeerSprite, 2, infile, 6);
+
+	loadSpriteFrame(rudolfSprite, 0, infile, 3);
+	loadSpriteFrame(rudolfSprite, 1, infile, 4);
+	loadSpriteFrame(rudolfSprite, 2, infile, 2);
+	
+	loadSpriteFrame(smokeSprite, 0, infile, 8);
+	loadSpriteFrame(smokeSprite, 1, infile, 9);
+	loadSpriteFrame(smokeSprite, 2, infile, 10);
+	loadSpriteFrame(smokeSprite, 3, infile, 11);
+	
+	close(infile);
+
+	animate;
+end.

lib/corelib.s

@@ -588,13 +588,19 @@ DIVU_END:
 
 ; wait approx. 1 millisecond
 ;
-; 83.333 MHz Clock, three instructions a 4 cycles
+; the ROM at address 4
-; 83333 / 12 = 6944.4166
+; contains the cpu clock freq in KHz
-; works only if executed without wait states (i.e.
+	.EQU CLK_KHZ_ADDR 4
-; from BRAM/SRAM)
 WAIT1MSEC:
-	LOADCP 6944
+	LOADC CLK_KHZ_ADDR
+	LOADI
+	; divide by 16
+	SHR
+	SHR
+	SHR
+	SHR
 WAIT1LOOP:
+	INC 0 ; NOP to make the loop 16 cycles long
 	DEC 1
 	DUP
 	CBRANCH.NZ WAIT1LOOP
@@ -606,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/rommon.s

@@ -7,8 +7,16 @@
 	.EQU UART_REG 2048
 	.EQU MON_ADDR 64512
 
+	.EQU CLK_KHZ 76923
+
 	BRANCH 2	; the very first instruction is not
 			; executed correctly
+	BRANCH MON_START ; branch over constant
+
+CLK_KHZ_ADDR:
+	.WORD CLK_KHZ  ; to calibrate the delay loop
+
+MON_START:
 	LOADCP 65020 ; initialise FP and RP registers
 	STOREREG FP
 	LOADCP 65024
@@ -782,13 +790,17 @@ COPY_BLK1:
 
 ; wait approx. 1 millisecond
 ;
-; 83.333 MHz Clock, three instructions a 4 cycles
-; 83333 / 12 = 6944.4166
-; works only if executed without wait states (i.e.
-; from BRAM/SRAM)
 WAIT1MSEC:
-	LOADCP 6944
+	; get clock freq in khz
+	LOADC CLK_KHZ_ADDR
+	LOADI
+	; divide by 16
+	SHR
+	SHR
+	SHR
+	SHR
 WAIT1LOOP:
+	INC 0	; NOP to make loop 16 cycles long
 	DEC 1
 	DUP
 	CBRANCH.NZ WAIT1LOOP
@@ -798,7 +810,7 @@ WAIT1LOOP:
 %include "sdcardboot.s"
 	.CPOOL
 MESSAGE:
-	.BYTE 13,10,"ROM Monitor v3.0.3", 13, 10,
+	.BYTE 13,10,"ROM Monitor v3.1.0", 13, 10,
 	      "Set A)ddress   D)eposit   eX)amine   L)oad   G)o  B)oot",13,10,0
 PROMPT2:
 	.BYTE "]> ",0

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,10 +149,11 @@ 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;index,count:integer):string; external;
+function copy(s:string[256];index,count:integer):string[256]; external;
-procedure insert(ins: string; var dest: string; position:integer); external;
+procedure insert(ins:string[256]; var dest:string[256]; position:integer); external;
 procedure delete(var s:string; from:integer; count:integer); external;
 function pos(substr:string;var s:string):integer; external;
 function pwroften(exp:integer):real; 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;
@@ -240,6 +242,7 @@ procedure freadreal(var v:real;var f:file); external;
 procedure openchannel(name:filenamestr; var f:file; mode:filemode; var error:integer); external;
 procedure open(var f:file; name:pathnamestr; mode: filemode); external;
 procedure noecho(var f:file; noecho:boolean; var old:boolean); external;
+procedure nointr(var f:file; aBool:boolean; var old:boolean); external;
 
 procedure intstr(v:integer; fieldWith:integer; var rbuf:string);
 	external;
@@ -269,8 +272,8 @@ procedure TextDefault; external;
 
 procedure PTerm; external; (* from runtime.s *)
 procedure PExec(prgfile:pathnamestr; var args:PArgVec; argCount:integer;var error:integer); external;
-procedure PExec2(prgfile:pathnamestr; arg1:string; var error:integer); external;
+procedure PExec1(prgfile:pathnamestr; arg1:string; var error:integer); external;
-procedure PExec3(prgfile:pathnamestr; arg1, arg2:string; var error:integer); external;
+procedure PExec2(prgfile:pathnamestr; arg1, arg2:string; var error:integer); external;
 function ParamStr(i:integer):string; external;
 function ParamCount():integer; 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;
 
@@ -47,7 +48,7 @@ type file = record
 			ateof:boolean;
 			noecho:boolean; (* read chars are not echoed *)
 			raw:boolean;  (* turn off backspace processing on input, CR processing on output *)
-			nointr: boolean); (* turn off keyboard interrupt character processing *)
+			nointr:boolean); (* turn off keyboard interrupt character processing *)
 
 		IODiskFile: (volumeid: integer;fileno: integer; filpos:integer; bufStart:integer;
 				size:integer; sizeExtents:integer;
@@ -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,13 +146,14 @@ var ioerrordesc: array [0..11] of string[20] = (
 	'File is readonly',
 	'Invalid operation',
 	'Invalid format',
+	'Not enough memory',
 	'Interrupted by user'
 	);
 
     matherror:string[38] = 'Invalid argument to sqrt/ln/tan/cotan';
     pexecerror:string[28]= 'Invalid arguments for PExec';
 
-    random_state:integer;
+    random_state:integer = -42;
 
     PArgs:array [0..PArgMax] of string external;
     PArgCount:integer external;
@@ -402,7 +404,7 @@ begin
 	GetCurTimestamp := GetTimestamp(now);
 end;
 
-function copy(s:string;index,count:integer):string;
+function copy(s:string[256];index,count:integer):string[256];
 var len:integer;
 begin
 	copy := '';
@@ -416,7 +418,7 @@ begin
 	end;
 end;
 
-procedure insert(ins: string; var dest: string; position:integer);
+procedure insert(ins:string[256]; var dest:string[256]; position:integer);
 var i,count,from,to_:integer;
 begin
 	if position < 1 then position := 1;
@@ -480,6 +482,9 @@ end;
    That means you cannot use pos to search inside a string
    literal. Hopefully this is not something you want to do.
    *)
+
+(* TODO: UCSD-Pascal and TP3.0 specs say, searched string
+   is a string expression so cannot be var parameter *)
 function pos(substr:string;var s:string):integer;
 var substrlen:integer;
     slen:integer;
@@ -1179,8 +1184,18 @@ ext:
 		v := x;
 		code := 0;
 	end
+	else
+	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);
@@ -1188,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;
@@ -1331,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);
@@ -1349,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
@@ -1537,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;
 
@@ -1662,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;
@@ -1812,6 +1844,8 @@ end;
 
 function filesize(var fil:file):integer;
 begin
+	checkerror(fil);
+
 	if fil.typ = IOChannel then
 		filesize := -1
 	else
@@ -2010,7 +2044,11 @@ begin
 
 	aFile.typ := IODiskFile;
 	aFile.mode := mode;
-	new(aFile.buffer);
+	newOrNil(aFile.buffer);
+	if aFile.buffer = nil then
+		fileerror(aFile, IONoMem)
+	else
+	begin
 		aFile.bufpos := 0;
 		aFile.bufsize := DefaultBufSize;
 		aFile.needsflush := false;
@@ -2027,6 +2065,7 @@ begin
 		aFile.extentBlocks := extentSize div 512;
 
 		seek(aFile,0);
+	end;
 end;
 
 procedure updatedirslot(var aFile:file);
@@ -2049,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);
-		if aFile.lastError = 0 then
+
-		begin
-			fileerror(aFile, IOFileClosed);
 		{ writeln('close f.buffer:', aFile.buffer); }
 		dispose(aFile.buffer);
 		aFile.buffer := nil;
 
+		if aFile.lastError = 0 then
+		begin
 			if aFile.changed then
 				updatedirslot(aFile);
-
+			if aFile.lastError = 0 then
+				fileerror(aFile, IOFileClosed);
 		end;
 
 		closevolumeid(aFile.volumeid);
@@ -2240,7 +2282,8 @@ begin
 
 	if volid > 0 then
 	begin
-		openvolumeid(volid);
+		openvolumeid(volid, error);
+		if error = 0 then
 			slotno := findfile(volid, fname, dirs, error)
 	end
 	else
@@ -2560,6 +2603,16 @@ begin
 	end;
 end;
 
+procedure nointr(var f:file;aBool:boolean;var old:boolean);
+begin
+	if f.typ <> IOChannel then
+		fileerror(f, IOInvalidOp)
+	else
+	begin
+		old := f.nointr;
+		f.nointr := aBool;
+	end;
+end;
 (*
   implementation of Xorshift algorithm by George Marsaglia,
   see: Marsaglia, George (July 2003).
@@ -2596,6 +2649,7 @@ begin
 		if ord(aChar) <= ord('z') then
 			upcase := chr(ord(aChar) - 32)
 		else
+			upcase := aChar
 	else
 		upcase := aChar;
 end;
@@ -2661,14 +2715,14 @@ begin
 	end;
 end;
 
-procedure PExec2(prgfile:pathnamestr; arg1:string; var error:integer);
+procedure PExec1(prgfile:pathnamestr; arg1:string; var error:integer);
 var args:PArgVec;
 begin
 	args[0] := arg1;
 	PExec(prgfile, args, 1, error);
 end;
 
-procedure PExec3(prgfile:pathnamestr; arg1, arg2:string; var error:integer);
+procedure PExec2(prgfile:pathnamestr; arg1, arg2:string; var error:integer);
 var args:PArgVec;
 begin
 	args[0] := arg1;

pcomp/Makefile

@@ -1,47 +1,44 @@
 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 libgen lsymgen
+all: pcomp sasm sdis lsymgen shortgen nativeprogs
 
-libs: pcomp sasm lsymgen libgen
+libs: pcomp sasm lsymgen shortgen
 	$(SASM) ../lib/coreloader.s
 	$(LSYMGEN) ../lib/coreloader.sym
 	$(PCOMP) -n ../lib/stdlib.pas
-	$(LIBGEN) ../lib/stdlib.s
+	$(SASM) ../lib/stdlibwrap.s ../lib/stdlib.lib
-	$(LIBGEN) ../lib/runtime.s
+	$(LSYMGEN) ../lib/stdlibwrap.sym ../lib/stdlib.lsym
-	$(LIBGEN) ../lib/float32.s
 
-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

@@ -17,7 +17,7 @@ rem exit /b
 py pcomp.py sasm.pas
 py pcomp.py pcomp.pas
 py pcomp.py lsymgen.pas
-py pcomp.py libgen.pas
+py pcomp.py shortgen.pas
 
 rem exit /b
 
@@ -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

@@ -1,4 +1,6 @@
 (* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
+{$H600}
+{$S64}
 program PascalCompiler;
 {$R+}
 {$!}{$ifdef FPC}uses math,crt;{$endif}
@@ -41,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);
@@ -261,7 +263,7 @@ const	insSize = 2;
 		MaxIncludes = 4;
 		StdLibName = 'stdlib';
 		UnitSuffix1 = '.inc';
-		UnitSuffix2 = '.lib';
+		UnitSuffix2 = '.s';
 		FilenameSuffix = '.pas';
 		OutfileSuffix = '.s';
 		InputFileName = 'INPUT';
@@ -289,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',
@@ -2184,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
@@ -2454,10 +2456,7 @@ begin
 	begin
 		digits := curToken.tokenText;
 		if matchTokenOrNot(MinusToken) then
-		begin
-			readNextToken;
 			digits := digits + curToken.tokenText;
-		end;
 		parseInteger := integerFromString(digits);
 	end;
 	readNextToken;
@@ -2810,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;
@@ -3229,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
@@ -3266,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;
 
@@ -3431,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
@@ -3997,6 +4014,8 @@ begin
 		begin
 			readNextToken;
 			length := parseInteger;
+			if length < 1 then
+				errorExit2('invalid string length', '');
 			matchToken(RBracketToken);
 		end;
 		typSpec.size := getStringMemSize(length);
@@ -4481,7 +4500,7 @@ begin
 	isFunction := aProc^.returnType.baseType <> NoType;
 end;
 
-procedure parseNew;
+procedure parseNew(checkNil:boolean);
 var memLoc: MemLocation;
     typeReturn: TypeSpec;
 begin
@@ -4507,17 +4526,17 @@ begin
 		emitLoadConstantInt(memLoc.typ.pointedType^.size);
 		emitMemAlloc;
 
-		if typeContainsString(memLoc.typ.pointedType^) then
-			emitClearAlloc(memLoc.typ.pointedType);
-	end;
-	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. *)
+		if typeContainsString(memLoc.typ.pointedType^) then
+			emitClearAlloc(memLoc.typ.pointedType);
+	end;
+	if checkNil then
+		emitCheckAlloc;
 
 	writeVariable(memLoc);
 
@@ -4998,7 +5017,9 @@ begin
 	NoSP:
 		errorExit2('internal error in parseSpecialProcCall', lastToken.tokenText);
 	NewSP:
-		parseNew;
+		parseNew(true);
+	New0SP:
+		parseNew(false);
 	DisposeSP:
 		parseDispose;
 	ReadSP:
@@ -5811,6 +5832,19 @@ begin
 	matchToken(ColonToken);
 end;
 
+procedure parseGotoStatement;
+var aLabl: LablRef;
+begin
+	readNextToken;
+	matchToken(IdentToken);
+	aLabl := findLabel(curProcedure, lastToken.tokenText);
+	if aLabl = nil then
+		errorExit2('GOTO to undefined label', lastToken.tokenText);
+	if curProcedure^.estackCleanup > 0 then
+		errorExit2('GOTO not allowed inside FOR or CASE', '');
+	emitLabelJump(aLabl);
+end;
+
 procedure parseStatement;
 var sym: SymblRef;
 	cnst: ConstRef;
@@ -5836,13 +5870,7 @@ begin
 	end;
 
 	if checkToken(GotoToken) then
-	begin
+		parseGotoStatement
-		readNextToken;
-		matchToken(IdentToken);
-		aLabl := findLabel(curProcedure, lastToken.tokenText);
-		if aLabl = nil then errorExit2('GOTO to undefined label', lastToken.tokenText);
-		emitLabelJump(aLabl);
-	end
 	else
 	if checkToken(IfToken) then
 		parseIfStatement

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,8 +1515,6 @@ begin
 		end;
 
 		if dref^.symboldata.value <> value then
-			(* writeln('////// label changed value ', keyword, ' ',
-				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;

pcomp/shortgen.pas

@@ -5,7 +5,7 @@ const	shortcutChar = '`';
 	firstShCChar = 'A';
 	lastShCChar = 'i';
 
-	OutfileSuffix = '.lib';
+	OutfileSuffix = '.cs';
 
 {$I 'platfile-types+.pas'}
 

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/editor.pas

@@ -8,7 +8,7 @@ const COMPILERPROG = '#SYSTEM:pcomp.prog';
 const MAX_LENGTH = 512;
       MAX_LINES = 10000;
       MAX_SCREENH = 256;
-      MAX_KEYWORD = 31;
+      MAX_KEYWORD = 33;
 
       MAX_CLIPB_SIZE = 300;
 
@@ -94,14 +94,14 @@ var lines: array [1..MAX_LINES] of ^linestr;
     catColors: array [Unknown..StrLit] of integer =
 	( TEXT_FG, 0, KEYWORD_FG, IDENT_FG, NUM_FG, PUNCT_FG, COMMENT_FG, STRLIT_FG );
 
-    keywords: array [0..MAX_KEYWORD] of string[20] = (
+    keywords: array [0..MAX_KEYWORD] of string[12] = (
-			'VAR', 'IF', 'THEN', 'ELSE', 'BEGIN', 'END', 'PROCEDURE', 'FUNCTION',
+			'AND', 'ARRAY', 'BEGIN', 'BOOLEAN', 'CASE', 'CHAR', 'CONST',
-			'WHILE', 'FOR', 'DO', 'IN', 'OF', 'CASE', 'TO', 'REPEAT', 'UNTIL',
+			'DIV', 'DO', 'ELSE', 'END', 'FOR', 'FUNCTION', 'IF', 'IN', 'INTEGER',
-			'CHAR', 'INTEGER', 'REAL', 'BOOLEAN', 'ARRAY', 'RECORD', 'STRING',
+			'MOD', 'NOT', 'OF', 'OR', 'PROCEDURE', 'PROGRAM',
-			'MOD', 'DIV', 'AND', 'OR', 'NOT',
+			'REAL', 'RECORD', 'REPEAT', 'STRING', 'THEN', 'TO', 'TYPE',
-			'TYPE', 'CONST',
+			'UNIT', 'UNTIL', 'USES', 'VAR', 'WHILE'
-			'PROGRAM'
 		);
+    keywordIdx: array ['A'..'Z'] of integer;
     paramPos:integer;
     errorLine:integer;
     errorMsg:string;
@@ -137,7 +137,8 @@ end;
 procedure getScreenSize;
 var c:char;
 begin
-	(* empty keyboard buffer *)
+	(* empty keyboard buffer to make sure GetTermSize
+		can read the response from the terminal *)
 	while conavail do read(con, c);
 
 	GetTermSize(screenW, screenH);
@@ -677,30 +678,6 @@ begin
 	hscroll;
 end;
 
-function isKeyword(var s:string):boolean;
-var i:integer;
-    c:char;
-    upBuf:string[MAX_LENGTH];
-begin
-	isKeyword := false;
-
-	if highlight then
-	begin
-		upBuf := '';
-		for c in s do appendchar(upBuf,upcase(c));
-
-
-		for i := 0 to MAX_KEYWORD do
-		begin
-			if keywords[i] = upBuf then
-			begin
-				isKeyword := true;
-				break;
-			end;
-		end;
-	end;
-end;
-
 function isalpha(c:char):boolean;
 begin
 	isalpha :=	((ord(c) >= ord('A')) and (ord(c) <= ord('Z'))) or
@@ -715,6 +692,39 @@ begin
 			((ord(c) >= ord('[')) and (ord(c) <= ord('^')));
 end;
 
+function isKeyword(var s:string):boolean;
+var i:integer;
+    start:integer;
+    c,f:char;
+    upBuf:string[MAX_LENGTH];
+begin
+	isKeyword := false;
+
+	if highlight then
+	begin
+		upBuf := '';
+		for c in s do appendchar(upBuf,upcase(c));
+
+		(* use the first letter of the search string
+			for our starting index *)
+		c := upBuf[1];
+		if isalpha(c) then
+		begin
+			start := keywordIdx[c];
+			for i := start to MAX_KEYWORD do
+			begin
+				f := keywords[i][1];
+				if c <> f then break;
+				if keywords[i] = upBuf then
+				begin
+					isKeyword := true;
+					break;
+				end;
+			end;
+		end;
+	end;
+end;
+
 function getCat(c:char):HiliteCat;
 begin
 	if isalpha(c) then
@@ -1652,11 +1662,10 @@ end;
 
 procedure gotoLine(l:integer);
 begin
-	if l < 1 then
-		l := 1
-	else
 	if l > lineCount then
 		l := lineCount;
+	if l < 1 then
+		l := 1;
 
 	topY := l - (screenH div 2);
 	if topY < 1 then
@@ -1704,7 +1713,7 @@ var error:integer;
 begin
 	success := true;
 	if isModified then
-		save;
+		writeFile(success);
 	if success then
 	begin
 		if isAsmFile(filename) then
@@ -2417,6 +2426,23 @@ begin
 	end;
 end;
 
+procedure initKeywordIdx;
+var i:integer;
+    ch, lastCh:char;
+begin
+	lastCh := #0;
+
+	for i := 0 to MAX_KEYWORD do
+	begin
+		ch := keywords[i][1];
+		if ch <> lastCh then
+		begin
+			keywordIdx[ch] := i;
+			lastCh := ch;
+		end;
+	end;
+end;
+
 begin
 	errorLine := 0;
 	paramPos := 1;
@@ -2424,6 +2450,8 @@ begin
 	autoindent := true;
 	keepClips := false;
 
+	initKeywordIdx;
+
 	while paramPos <= ParamCount do
 	begin
 		if paramStr(paramPos) = '-l' then

progs/reclaim.pas

@@ -62,8 +62,13 @@ begin
 	begin
 		if lastUsed < endSlot then
 		begin
-			writeln('Updating directory...');
+			(* if the volume is empty mark the first slot *)
+			if lastUsed = 0 then
+				slotNo := reservedCount
+			else
 				slotNo := lastUsed + 1;
+
+			writeln('Updating directory...');
 			getdirslot(volid, slotNo, dirslot, error);
 			if error <> IONoError then
 			begin
@@ -118,8 +123,9 @@ begin
 		freeAreaCount := 0;
 		lastUsed := 0;
 
-		openvolumeid(volid);
+		openvolumeid(volid, error);
-		i := volumeTable[volid].startSlot;
+			(* ignoring theoretically possible out-of-heap-error *)
+		i := 0;
 		endSlot := volumeTable[volid].part.dirSize - 1;
 
 		if verbose then
@@ -303,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
@@ -324,7 +324,7 @@ begin
 		PExec(EDITORPROG, args, 3, error);
 	end
 	else
-		PExec2(EDITORPROG, ShellWorkFile, error);
+		PExec1(EDITORPROG, ShellWorkFile, error);
 	writeln('PExec error ', error);
 end;
 
@@ -334,7 +334,7 @@ var filename:filenamestr;
 begin
 	requireWorkfile;
 	filename := replaceExtension(ShellWorkFile, '.s');
-	PExec2(ASMPROG, filename, error);
+	PExec1(ASMPROG, filename, error);
 	writeln('PExec error ', error);
 end;
 
@@ -344,7 +344,7 @@ var filename:filenamestr;
 begin
 	requireWorkfile;
 	filename := replaceExtension(ShellWorkFile, '.pas');
-	PExec3(COMPILERPROG, '-S', filename, error);
+	PExec2(COMPILERPROG, '-S', filename, error);
 	writeln('PExec error ', error);
 end;
 
@@ -354,7 +354,7 @@ var filename:filenamestr;
 begin
 	requireWorkfile;
 	filename := replaceExtension(ShellWorkFile, '.pas');
-	PExec2(COMPILERPROG, filename, error);
+	PExec1(COMPILERPROG, filename, error);
 	writeln('PExec error ', error);
 end;
 
@@ -373,7 +373,7 @@ end;
 procedure krunch;
 var error:integer;
 begin
-	PExec2(RECLAIMPROG, DefaultVolume, error);
+	PExec1(RECLAIMPROG, DefaultVolume, error);
 	writeln('PExec error ', error);
 end;
 

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/gototest.pas

@@ -0,0 +1,22 @@
+program gototest;
+var i:integer;
+label l1,l2;
+begin
+	goto l1;
+	writeln('skipped');
+	l1: writeln('goto destination 1');
+	{
+	for i := 1 to 10 do
+	begin
+		goto l2;
+	end;
+	}
+	{
+	case i of
+	1: writeln('1');
+	2: goto l2;
+	3..10: writeln('3 - 10');
+	end;
+	l2: writeln('goto destination 2');
+	}
+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]
@@ -216,3 +216,5 @@ set_property -dict {PACKAGE_PIN C2 IOSTANDARD LVCMOS33} [get_ports rst]
 #set_property -dict { PACKAGE_PIN A15   IOSTANDARD LVCMOS33     } [get_ports { isns0v95_p }]; #IO_L8P_T1_AD10P_15 Sch=ad_p[10]
 
 set_property BITSTREAM.GENERAL.COMPRESS True [current_design]
+
+set_max_delay -from [get_pins vgafb0/display_timings_inst/o_vblank_reg/C] -to [get_pins vgafb0/vblank_xfer_reg/D] 3.000

tridoracpu/tridoracpu.srcs/cpuclk.v

@@ -17,7 +17,9 @@ module cpu_clkgen(
         .CLKFBOUT_PHASE(0.0),       // Phase offset in degrees of CLKFB (-360.000-360.000).
         .CLKIN1_PERIOD(10.0),       // Input clock period in ns to ps resolution (i.e. 33.333 is 30 MHz).
         // CLKOUT0_DIVIDE - CLKOUT6_DIVIDE: Divide amount for each CLKOUT (1-128)
-        .CLKOUT0_DIVIDE_F(12.0),    // Divide amount for CLKOUT0 (1.000-128.000).
+        // CPU Clock: 12.0 = 83.33MHz CPU Clock, 333.33MHz Memory Clock
+        // 13.0 = 76.92MHz CPU Clock, 307.69MHz Memory Clock
+        .CLKOUT0_DIVIDE_F(13.0),    // Divide amount for CLKOUT0 (1.000-128.000).
         .CLKOUT1_DIVIDE(5),
         .CLKOUT2_DIVIDE(40),        // 40 = 25MHz pixel clock (should be 25.175MHz per spec) for 640x480
         //.CLKOUT2_DIVIDE(25),        // 25 = 40MHz pixel clock for 800x600

tridoracpu/tridoracpu.srcs/dram_bridge.v

@@ -8,6 +8,7 @@ module dram_bridge #(ADDR_WIDTH = 32, WIDTH = 32)
     input wire [WIDTH-1:0]      mem_write_data,
     input wire                  mem_read_enable,
     input wire                  mem_write_enable,
+    input wire                  mem_read_ins,
     output wire                 mem_wait,
 
     input wire                  rst_n,
@@ -105,39 +106,57 @@ module dram_bridge #(ADDR_WIDTH = 32, WIDTH = 32)
        .sys_rst                        (rst_n)
     );
 
-//    reg [DRAM_DATA_WIDTH-1:0] 	read_cache;
+    (*KEEP*) reg [DRAM_DATA_WIDTH-1:0] 	ins_cache;
-//    reg [ADDR_WIDTH-1:0]      	cached_addr;
+    (*KEEP*) reg [DRAM_ADDR_WIDTH-1:4]  icached_addr;
-//    wire 		      	cache_hit = cached_addr == mem_addr;
+    (*KEEP*) wire                       icache_hit = mem_read_enable && mem_read_ins && (icached_addr == mem_addr[DRAM_ADDR_WIDTH-1:4]);
-//    wire [DRAM_DATA_WIDTH-1:0]  read_data_wrapper = cache_hit ? read_cache : app_rd_data;
+
+    (*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;
+    wire dram_read_enable = mem_read_enable && !cache_hit;
 
     assign app_rd_data_end = 1'b1;
-    //assign app_wdf_mask = 16'b1111111111111100;
 
     // addresses on the memory interface are aligned to 16 bytes
     // and 28 bits wide (=256MB)
     assign app_addr = { mem_addr[DRAM_ADDR_WIDTH:4], 4'b0000 };
-    //assign app_addr = { 28'b0 };
  
     // select a word from the 128 bits transferred by the dram controller
     // according to the lower bits of the address (ignoring bits 1:0)
-    wire [WIDTH-1:0] read_word;
     wire [1:0] word_sel = mem_addr[3:2];
 
-    assign read_word =  word_sel == 3'b11 ? app_rd_data[31:0]  :
+    wire [WIDTH-1:0] read_word =
-                        word_sel == 3'b10 ? app_rd_data[63:32] :
+                        word_sel == 2'b11 ? app_rd_data[31:0]  :
-                        word_sel == 3'b01 ? app_rd_data[95:64] :
+                        word_sel == 2'b10 ? app_rd_data[63:32] :
+                        word_sel == 2'b01 ? app_rd_data[95:64] :
                                             app_rd_data[127:96];
 
-    assign mem_read_data = app_rd_data_valid ? read_word : read_buf;
+    wire [WIDTH-1:0] read_icached_word =
+                        word_sel == 2'b11 ? ins_cache[31:0]  :
+                        word_sel == 2'b10 ? ins_cache[63:32] :
+                        word_sel == 2'b01 ? ins_cache[95:64] :
+                                            ins_cache[127:96];
+
+    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;
@@ -145,21 +164,67 @@ module dram_bridge #(ADDR_WIDTH = 32, WIDTH = 32)
     assign app_wdf_end =  mem_write_enable & write_ready;
     assign app_wdf_data = { {4{mem_write_data}} };
 
-    assign mem_wait =   (mem_read_enable & ~read_inprogress) |
+    assign mem_wait =   (dram_read_enable & ~read_inprogress) |
                         (mem_write_enable & (~app_wdf_rdy | ~app_rdy)) |
                         (read_inprogress & ~app_rd_data_valid);
 
-    assign app_en = (mem_read_enable & ~read_inprogress) |
+    assign app_en = (dram_read_enable & ~read_inprogress) |
             (mem_write_enable & write_ready);
-    assign app_cmd = mem_read_enable ? CMD_READ : CMD_WRITE;
+    assign app_cmd = dram_read_enable ? CMD_READ : CMD_WRITE;
 
+
+    /* set instruction cache */
     always @(posedge dram_front_clk)
     begin
-        if(mem_read_enable & ~read_inprogress & app_rdy)
+        if(dram_read_enable && mem_read_ins && app_rd_data_valid)
+        begin
+            ins_cache <= app_rd_data;
+            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(mem_read_enable & app_rd_data_valid)
+
+        if(dram_read_enable & app_rd_data_valid)
             read_buf <= mem_read_data;
+        else
+        if (mem_read_enable & icache_hit)
+            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

@@ -28,7 +28,7 @@ module rom32 #(parameter ADDR_WIDTH = 11, DATA_WIDTH = 32)
     input wire read_enable
     );
     
-  wire [ADDR_WIDTH-2:0] internal_addr = addr[ADDR_WIDTH-1:2];   // -> ignore bit 0
+  wire [ADDR_WIDTH-2:0] internal_addr = addr[ADDR_WIDTH-1:2];   // -> ignore bits 1-0
   reg [DATA_WIDTH-1:0] rom [0:(2**(ADDR_WIDTH-2))-1];
   
   initial begin
@@ -51,7 +51,7 @@ module ram32 #(parameter ADDR_WIDTH = 16, DATA_WIDTH = 32)
     );
   
   reg [DATA_WIDTH-1:0] ram [0:(2**(ADDR_WIDTH-2))-1];           // 32bit words with byte addressing
-  wire [ADDR_WIDTH-2:0] internal_addr = addr[ADDR_WIDTH-1:2];   // -> ignore bit 1-0
+  wire [ADDR_WIDTH-2:0] internal_addr = addr[ADDR_WIDTH-1:2];   // -> ignore bits 1-0
     
   always @(posedge clk)
   begin
@@ -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/mig_dram_0/mig_a.prj

@@ -39,12 +39,12 @@
 
   <Controller number="0">
     <MemoryDevice>DDR3_SDRAM/Components/MT41K128M16XX-15E</MemoryDevice>
-    <TimePeriod>3000</TimePeriod>
+    <TimePeriod>3300</TimePeriod>
     <VccAuxIO>1.8V</VccAuxIO>
     <PHYRatio>4:1</PHYRatio>
-    <InputClkFreq>83.333</InputClkFreq>
+    <InputClkFreq>75.757</InputClkFreq>
     <UIExtraClocks>0</UIExtraClocks>
-    <MMCM_VCO>666</MMCM_VCO>
+    <MMCM_VCO>606</MMCM_VCO>
     <MMCMClkOut0> 1.000</MMCMClkOut0>
     <MMCMClkOut1>1</MMCMClkOut1>
     <MMCMClkOut2>1</MMCMClkOut2>

tridoracpu/tridoracpu.srcs/mig_dram_0/mig_b.prj

@@ -39,12 +39,12 @@
 
   <Controller number="0">
     <MemoryDevice>DDR3_SDRAM/Components/MT41K128M16XX-15E</MemoryDevice>
-    <TimePeriod>3000</TimePeriod>
+    <TimePeriod>3250</TimePeriod>
     <VccAuxIO>1.8V</VccAuxIO>
     <PHYRatio>4:1</PHYRatio>
-    <InputClkFreq>83.333</InputClkFreq>
+    <InputClkFreq>76.923</InputClkFreq>
     <UIExtraClocks>0</UIExtraClocks>
-    <MMCM_VCO>666</MMCM_VCO>
+    <MMCM_VCO>615</MMCM_VCO>
     <MMCMClkOut0> 1.000</MMCMClkOut0>
     <MMCMClkOut1>1</MMCMClkOut1>
     <MMCMClkOut2>1</MMCMClkOut2>

tridoracpu/tridoracpu.srcs/sdspi.v

@@ -107,7 +107,7 @@ module sdspi(
         tx_fifo_empty
     );
 
-    fifo #(.ADDR_WIDTH(8)) rx_fifo(clk, reset,
+    fifo #(.ADDR_WIDTH(10)) rx_fifo(clk, reset,
         rx_fifo_wr_en, rx_fifo_rd_en,
         rx_shifter, rx_fifo_out,
         rx_fifo_full,

tridoracpu/tridoracpu.srcs/stackcpu.v

@@ -11,20 +11,14 @@ module stackcpu #(parameter ADDR_WIDTH = 32, WIDTH = 32,
     output reg [ADDR_WIDTH-1:0] addr,
     input wire [WIDTH-1:0] data_in,
     output wire read_enable,
+    output wire read_ins,
     output wire [WIDTH-1:0] data_out,
     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
-    
-    output wire [WIDTH-1:0] debug_out1,
-    output wire [WIDTH-1:0] debug_out2,
-    output wire [WIDTH-1:0] debug_out3,
-    output wire [WIDTH-1:0] debug_out4,
-    output wire [WIDTH-1:0] debug_out5,
-    output wire [WIDTH-1:0] debug_out6
     );
 
     localparam EVAL_STACK_INDEX_WIDTH = 6;
@@ -96,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);
@@ -111,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
@@ -182,6 +169,8 @@ module stackcpu #(parameter ADDR_WIDTH = 32, WIDTH = 32,
     assign mem_read_enable  = (seq_state == FETCH) || (seq_state == EXEC && mem_read);
     assign mem_write_enable = (seq_state == MEM && mem_write);
     
+    assign read_ins = (seq_state == FETCH) || (seq_state == DECODE);
+ 
     initial
     begin
         PC <= 0; nPC <= 0; seq_state <= MEM;

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

@@ -3,19 +3,18 @@
 // or as clk_1hz for debugging
 
 `define clock cpuclk
-`define clkfreq 83333333
+//`define clkfreq 83333333
+`define clkfreq 76923076
 //`define clock clk
 //`define clkfreq 100000000
 //`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,
@@ -59,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;
@@ -67,10 +73,11 @@ module top(
     localparam ADDR_WIDTH = 32, WIDTH = 32,
             ROMADDR_WIDTH = 11, IOADDR_WIDTH = 11, IOADDR_SEL = 4;
     
-    wire [ADDR_WIDTH-1:0] mem_addr;
+    (* KEEP *) wire [ADDR_WIDTH-1:0] mem_addr;
     wire [WIDTH-1:0] mem_read_data;
     wire [WIDTH-1:0] mem_write_data;
     (* KEEP *) wire mem_wait;
+    assign led0 = mem_wait;
 
     (* KEEP *) wire mem_read_enable;
     (* KEEP *) wire mem_write_enable;
@@ -80,14 +87,6 @@ module top(
 
     wire irq;
 
-    // assign led0 = mem_wait;
-    
-    wire [WIDTH-1:0] debug_data1, debug_data2,
-        debug_data3, debug_data4,
-        debug_data5, debug_data6;
-
-    assign led0 = debug_data6[0];
-
     wire cpuclk, cpuclk_locked;
     wire dram_refclk200;
     wire pixclk;
@@ -97,9 +96,11 @@ module top(
     wire [ADDR_WIDTH-1:0] dram_addr;
     wire [WIDTH-1:0] dram_read_data, dram_write_data;
     wire dram_read_enable, dram_write_enable, dram_wait;
+    (* KEEP *) wire dram_read_ins;
 
     dram_bridge dram_bridge0 (dram_addr,
-        dram_read_data, dram_write_data, dram_read_enable, dram_write_enable, dram_wait,
+        dram_read_data, dram_write_data, dram_read_enable, dram_write_enable,
+        dram_read_ins, dram_wait,
         rst, cpuclk, dram_refclk200,
         ddr3_dq, ddr3_dqs_n, ddr3_dqs_p, ddr3_addr,
         ddr3_ba, ddr3_ras_n, ddr3_cas_n, ddr3_we_n,
@@ -224,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);
 
@@ -240,29 +274,19 @@ 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),
         .data_in(mem_read_data), .read_enable(mem_read_enable),
+        .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));
-        .debug_out1(debug_data1),
-        .debug_out2(debug_data2),
-        .debug_out3(debug_data3),
-        .debug_out4(debug_data4),
-        .debug_out5(debug_data5),
-        .debug_out6(debug_data6));
 
     // 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)
@@ -62,10 +65,11 @@ module display_timings #(
     // o_scanline: high for one tick at the start of each visible scanline
     assign o_scanline = (o_sy >= VA_STA) && (o_sy <= VA_END) && (o_sx == H_STA);
 
+    // set vblank at end of frame, clear at start
     always @(posedge i_pix_clk)
     begin
-        if(o_frame) o_vblank <= 1;
+        if(o_sy == VA_END) o_vblank <= 1;
-        else if (o_de) o_vblank <= 0;
+        else if (o_sy == -1) o_vblank <= 0;
     end
 
     always @ (posedge i_pix_clk)
@@ -125,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?
@@ -175,6 +181,7 @@ module vgafb #(VMEM_ADDR_WIDTH = 15, VMEM_DATA_WIDTH = 32) (
     wire scanline;                  // scanline start
     wire vblank;                    // vertical blank
     reg  vblank_buf;                // vertical blank in cpu clock domain
+    reg  vblank_xfer;               // vertical blank clock domain crossing
 
     display_timings #(              // 640x480  800x600 1280x720 1920x1080
 `ifdef RES_1024_768
@@ -200,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 (
@@ -215,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;
@@ -233,7 +254,7 @@ module vgafb #(VMEM_ADDR_WIDTH = 15, VMEM_DATA_WIDTH = 32) (
 
     always @(posedge pix_clk) frame_d <= frame;
 
-    always @(posedge cpu_clk) vblank_buf <= vblank;
+    always @(posedge cpu_clk) { vblank_buf, vblank_xfer } <= { vblank_xfer, vblank };
 
     always @(posedge cpu_clk)
     begin
@@ -286,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

@@ -1,9 +1,10 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<!-- Product Version: Vivado v2020.1 (64-bit)              -->
+<!-- Product Version: Vivado v2024.2.2 (64-bit)                              -->
 <!--                                                                         -->
-<!-- Copyright 1986-2020 Xilinx, Inc. All Rights Reserved.   -->
+<!-- Copyright 1986-2022 Xilinx, Inc. All Rights Reserved.                   -->
+<!-- Copyright 2022-2025 Advanced Micro Devices, Inc. All Rights Reserved.   -->
 
-<Project Version="7" Minor="49" Path="./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"/>
@@ -12,29 +13,48 @@
     <Option Name="CompiledLibDirXSim" Val=""/>
     <Option Name="CompiledLibDirModelSim" Val="$PCACHEDIR/compile_simlib/modelsim"/>
     <Option Name="CompiledLibDirQuesta" Val="$PCACHEDIR/compile_simlib/questa"/>
-    <Option Name="CompiledLibDirIES" Val="$PCACHEDIR/compile_simlib/ies"/>
     <Option Name="CompiledLibDirXcelium" Val="$PCACHEDIR/compile_simlib/xcelium"/>
     <Option Name="CompiledLibDirVCS" Val="$PCACHEDIR/compile_simlib/vcs"/>
     <Option Name="CompiledLibDirRiviera" Val="$PCACHEDIR/compile_simlib/riviera"/>
     <Option Name="CompiledLibDirActivehdl" Val="$PCACHEDIR/compile_simlib/activehdl"/>
     <Option Name="SimulatorInstallDirModelSim" Val=""/>
     <Option Name="SimulatorInstallDirQuesta" Val=""/>
-    <Option Name="SimulatorInstallDirIES" Val=""/>
     <Option Name="SimulatorInstallDirXcelium" Val=""/>
     <Option Name="SimulatorInstallDirVCS" Val=""/>
     <Option Name="SimulatorInstallDirRiviera" Val=""/>
     <Option Name="SimulatorInstallDirActiveHdl" Val=""/>
-    <Option Name="BoardPart" Val="digilentinc.com:arty-a7-35:part0:1.0"/>
+    <Option Name="SimulatorGccInstallDirModelSim" Val=""/>
-    <Option Name="BoardPartRepoPaths" Val="$PPRDIR/../../../../AppData/Roaming/Xilinx/Vivado/2020.1/xhub/board_store/xilinx_board_store"/>
+    <Option Name="SimulatorGccInstallDirQuesta" Val=""/>
+    <Option Name="SimulatorGccInstallDirXcelium" Val=""/>
+    <Option Name="SimulatorGccInstallDirVCS" Val=""/>
+    <Option Name="SimulatorGccInstallDirRiviera" Val=""/>
+    <Option Name="SimulatorGccInstallDirActiveHdl" Val=""/>
+    <Option Name="SimulatorVersionXsim" Val="2024.2"/>
+    <Option Name="SimulatorVersionModelSim" Val="2024.1"/>
+    <Option Name="SimulatorVersionQuesta" Val="2024.1"/>
+    <Option Name="SimulatorVersionXcelium" Val="23.03.002"/>
+    <Option Name="SimulatorVersionVCS" Val="U-2023.03-1"/>
+    <Option Name="SimulatorVersionRiviera" Val="2024.04"/>
+    <Option Name="SimulatorVersionActiveHdl" Val="15.0"/>
+    <Option Name="SimulatorGccVersionXsim" Val="9.3.0"/>
+    <Option Name="SimulatorGccVersionModelSim" Val="7.4.0"/>
+    <Option Name="SimulatorGccVersionQuesta" Val="7.4.0"/>
+    <Option Name="SimulatorGccVersionXcelium" Val="9.3.0"/>
+    <Option Name="SimulatorGccVersionVCS" Val="9.2.0"/>
+    <Option Name="SimulatorGccVersionRiviera" Val="9.3.0"/>
+    <Option Name="SimulatorGccVersionActiveHdl" Val="9.3.0"/>
+    <Option Name="BoardPart" Val=""/>
     <Option Name="SourceMgmtMode" Val="DisplayOnly"/>
     <Option Name="ActiveSimSet" Val="sim_sdspi"/>
     <Option Name="DefaultLib" Val="xil_defaultlib"/>
     <Option Name="ProjectType" Val="Default"/>
     <Option Name="IPOutputRepo" Val="$PCACHEDIR/ip"/>
-    <Option Name="IPDefaultOutputPath" Val="$PSRCDIR/sources_1"/>
+    <Option Name="IPDefaultOutputPath" Val="$PGENDIR/sources_1"/>
     <Option Name="IPCachePermission" Val="read"/>
     <Option Name="IPCachePermission" Val="write"/>
     <Option Name="EnableCoreContainer" Val="FALSE"/>
+    <Option Name="EnableResourceEstimation" Val="FALSE"/>
+    <Option Name="SimCompileState" Val="TRUE"/>
     <Option Name="CreateRefXciForCoreContainers" Val="FALSE"/>
     <Option Name="IPUserFilesDir" Val="$PIPUSERFILESDIR"/>
     <Option Name="IPStaticSourceDir" Val="$PIPUSERFILESDIR/ipstatic"/>
@@ -47,13 +67,13 @@
     <Option Name="WTVcsLaunchSim" Val="0"/>
     <Option Name="WTRivieraLaunchSim" Val="0"/>
     <Option Name="WTActivehdlLaunchSim" Val="0"/>
-    <Option Name="WTXSimExportSim" Val="4"/>
+    <Option Name="WTXSimExportSim" Val="6"/>
-    <Option Name="WTModelSimExportSim" Val="4"/>
+    <Option Name="WTModelSimExportSim" Val="6"/>
-    <Option Name="WTQuestaExportSim" Val="4"/>
+    <Option Name="WTQuestaExportSim" Val="6"/>
     <Option Name="WTIesExportSim" Val="4"/>
-    <Option Name="WTVcsExportSim" Val="4"/>
+    <Option Name="WTVcsExportSim" Val="6"/>
-    <Option Name="WTRivieraExportSim" Val="4"/>
+    <Option Name="WTRivieraExportSim" Val="6"/>
-    <Option Name="WTActivehdlExportSim" Val="4"/>
+    <Option Name="WTActivehdlExportSim" Val="6"/>
     <Option Name="GenerateIPUpgradeLog" Val="TRUE"/>
     <Option Name="XSimRadix" Val="hex"/>
     <Option Name="XSimTimeUnit" Val="ns"/>
@@ -65,9 +85,11 @@
     <Option Name="SimTypes" Val="tlm_dpi"/>
     <Option Name="MEMEnableMemoryMapGeneration" Val="TRUE"/>
     <Option Name="DcpsUptoDate" Val="TRUE"/>
+    <Option Name="UseInlineHdlIP" Val="TRUE"/>
+    <Option Name="LocalIPRepoLeafDirName" Val="ip_repo"/>
   </Configuration>
-  <FileSets Version="1" Minor="31">
+  <FileSets Version="1" Minor="32">
-    <FileSet Name="sources_1" Type="DesignSrcs" RelSrcDir="$PSRCDIR">
+    <FileSet Name="sources_1" Type="DesignSrcs" RelSrcDir="$PSRCDIR" RelGenDir="$PGENDIR/sources_1">
       <Filter Type="Srcs"/>
       <File Path="$PSRCDIR/cpuclk.v">
         <FileInfo>
@@ -89,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"/>
@@ -120,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"/>
@@ -151,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"/>
@@ -183,12 +205,19 @@
           <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"/>
       </Config>
     </FileSet>
-    <FileSet Name="constrs_1" Type="Constrs" RelSrcDir="$PSRCDIR">
+    <FileSet Name="constrs_1" Type="Constrs" RelSrcDir="$PSRCDIR" RelGenDir="$PGENDIR/constrs_1">
       <Filter Type="Constrs"/>
       <File Path="$PSRCDIR/Arty-A7-35-Master.xdc">
         <FileInfo>
@@ -201,7 +230,7 @@
         <Option Name="ConstrsType" Val="XDC"/>
       </Config>
     </FileSet>
-    <FileSet Name="sim_1" Type="SimulationSrcs" RelSrcDir="$PSRCDIR">
+    <FileSet Name="sim_1" Type="SimulationSrcs" RelSrcDir="$PSRCDIR" RelGenDir="$PGENDIR/sim_1">
       <Filter Type="Srcs"/>
       <File Path="$PSRCDIR/uart_tb.v"/>
       <File Path="$PPRDIR/testbench_behav1.wcfg">
@@ -224,28 +253,19 @@
         <Option Name="SrcSet" Val="sources_1"/>
         <Option Name="XSimWcfgFile" Val="$PPRDIR/testbench_behav.wcfg"/>
         <Option Name="XSimWcfgFile" Val="$PPRDIR/testbench_behav1.wcfg"/>
+        <Option Name="CosimPdi" Val=""/>
+        <Option Name="CosimPlatform" Val=""/>
+        <Option Name="CosimElf" Val=""/>
         <Option Name="NLNetlistMode" Val="funcsim"/>
       </Config>
     </FileSet>
-    <FileSet Name="utils_1" Type="Utils" RelSrcDir="$PSRCDIR/utils_1">
+    <FileSet Name="utils_1" Type="Utils" RelSrcDir="$PSRCDIR/utils_1" RelGenDir="$PGENDIR/utils_1">
       <Filter Type="Utils"/>
       <Config>
         <Option Name="TopAutoSet" Val="TRUE"/>
       </Config>
     </FileSet>
-    <FileSet Name="mig_dram_0" Type="BlockSrcs" RelSrcDir="$PSRCDIR/mig_dram_0">
+    <FileSet Name="sim_fifo" Type="SimulationSrcs" RelSrcDir="$PSRCDIR/sim_fifo" RelGenDir="$PGENDIR/sim_fifo">
-      <File Path="$PSRCDIR/mig_dram_0/mig_dram_0.xci">
-        <FileInfo>
-          <Attr Name="UsedIn" Val="synthesis"/>
-          <Attr Name="UsedIn" Val="implementation"/>
-        </FileInfo>
-      </File>
-      <Config>
-        <Option Name="TopModule" Val="mig_dram_0"/>
-        <Option Name="UseBlackboxStub" Val="1"/>
-      </Config>
-    </FileSet>
-    <FileSet Name="sim_fifo" Type="SimulationSrcs" RelSrcDir="$PSRCDIR/sim_fifo">
       <Filter Type="Srcs"/>
       <File Path="$PSRCDIR/fifo.v">
         <FileInfo>
@@ -272,9 +292,12 @@
         <Option Name="PamSignalDriverFile" Val="xil_bypass_driver"/>
         <Option Name="PamPseudoTop" Val="pseudo_tb"/>
         <Option Name="SrcSet" Val="sources_1"/>
+        <Option Name="CosimPdi" Val=""/>
+        <Option Name="CosimPlatform" Val=""/>
+        <Option Name="CosimElf" Val=""/>
       </Config>
     </FileSet>
-    <FileSet Name="sim_sdspi" Type="SimulationSrcs" RelSrcDir="$PSRCDIR/sim_sdspi">
+    <FileSet Name="sim_sdspi" Type="SimulationSrcs" RelSrcDir="$PSRCDIR/sim_sdspi" RelGenDir="$PGENDIR/sim_sdspi">
       <Filter Type="Srcs"/>
       <File Path="$PPRDIR/sdspi_testbench_behav.wcfg">
         <FileInfo>
@@ -295,9 +318,24 @@
         <Option Name="PamPseudoTop" Val="pseudo_tb"/>
         <Option Name="SrcSet" Val="sources_1"/>
         <Option Name="XSimWcfgFile" Val="$PPRDIR/sdspi_testbench_behav.wcfg"/>
+        <Option Name="CosimPdi" Val=""/>
+        <Option Name="CosimPlatform" Val=""/>
+        <Option Name="CosimElf" Val=""/>
         <Option Name="xsim.simulate.runtime" Val="10ms"/>
       </Config>
     </FileSet>
+    <FileSet Name="mig_dram_0" Type="BlockSrcs" RelSrcDir="$PSRCDIR/mig_dram_0" RelGenDir="$PGENDIR/mig_dram_0">
+      <File Path="$PSRCDIR/mig_dram_0/mig_dram_0.xci">
+        <FileInfo>
+          <Attr Name="UsedIn" Val="synthesis"/>
+          <Attr Name="UsedIn" Val="implementation"/>
+        </FileInfo>
+      </File>
+      <Config>
+        <Option Name="TopModule" Val="mig_dram_0"/>
+        <Option Name="UseBlackboxStub" Val="1"/>
+      </Config>
+    </FileSet>
   </FileSets>
   <Simulators>
     <Simulator Name="XSim">
@@ -317,56 +355,54 @@
       <Option Name="Description" Val="Active-HDL Simulator"/>
     </Simulator>
   </Simulators>
-  <Runs Version="1" Minor="11">
+  <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">
+    <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>
-    <Run Id="mig_dram_0_synth_1" Type="Ft3:Synth" SrcSet="mig_dram_0" Part="xc7a35ticsg324-1L" ConstrsSet="mig_dram_0" Description="Vivado Synthesis Defaults" AutoIncrementalCheckpoint="false" WriteIncrSynthDcp="false" Dir="$PRUNDIR/mig_dram_0_synth_1" IncludeInArchive="true">
+    <Run Id="mig_dram_0_synth_1" Type="Ft3:Synth" SrcSet="mig_dram_0" Part="xc7a35ticsg324-1L" ConstrsSet="mig_dram_0" Description="Vivado Synthesis Defaults" AutoIncrementalCheckpoint="false" WriteIncrSynthDcp="false" Dir="$PRUNDIR/mig_dram_0_synth_1" IncludeInArchive="true" IsChild="false" AutoIncrementalDir="$PSRCDIR/utils_1/imports/mig_dram_0_synth_1" AutoRQSDir="$PSRCDIR/utils_1/imports/mig_dram_0_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"/>
         <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>
-    <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" GenFullBitstream="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>
-    <Run Id="mig_dram_0_impl_1" Type="Ft2:EntireDesign" Part="xc7a35ticsg324-1L" ConstrsSet="mig_dram_0" Description="Default settings for Implementation." AutoIncrementalCheckpoint="false" WriteIncrSynthDcp="false" SynthRun="mig_dram_0_synth_1" IncludeInArchive="false" GenFullBitstream="true">
+    <Run Id="mig_dram_0_impl_1" Type="Ft2:EntireDesign" Part="xc7a35ticsg324-1L" ConstrsSet="mig_dram_0" Description="Default settings for Implementation." AutoIncrementalCheckpoint="false" WriteIncrSynthDcp="false" SynthRun="mig_dram_0_synth_1" IncludeInArchive="false" IsChild="false" GenFullBitstream="true" AutoIncrementalDir="$PSRCDIR/utils_1/imports/mig_dram_0_impl_1" AutoRQSDir="$PSRCDIR/utils_1/imports/mig_dram_0_impl_1" ParallelReportGen="true">
       <Strategy Version="1" Minor="2">
-        <StratHandle Name="Vivado Implementation Defaults" Flow="Vivado Implementation 2020"/>
+        <StratHandle Name="Vivado Implementation Defaults" Flow="Vivado Implementation 2024"/>
         <Step Id="init_design"/>
         <Step Id="opt_design"/>
         <Step Id="power_opt_design"/>
@@ -377,14 +413,12 @@
         <Step Id="post_route_phys_opt_design"/>
         <Step Id="write_bitstream"/>
       </Strategy>
-      <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>
   </Runs>
-  <Board>
+  <Board/>
-    <Jumpers/>
-  </Board>
   <DashboardSummary Version="1" Minor="0">
     <Dashboards>
       <Dashboard Name="default_dashboard">

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/framebuffer.go

@@ -32,6 +32,7 @@ type Framebuffer struct {
 	paletteSlot word
 	vmem [VmemWords]word
 	readCount int
+        paletteChanged bool
 }
 
 func (f *Framebuffer) initialize() {
@@ -104,6 +105,26 @@ func (f *Framebuffer) readPalette() word {
 	return word(0)
 }
 
+func (f *Framebuffer) startFrame() {
+	// when the palette changes, we
+	// need to redraw every pixel
+	// to get the new colors
+	if f.paletteChanged {
+		oldRAddr := f.readAddr
+		oldWAddr := f.writeAddr
+		f.readAddr = 0
+		f.writeAddr = 0
+
+		for i := 0; i < VmemWords; i++ {
+			f.writeVmem(f.readVmem())
+		}
+
+		f.readAddr = oldRAddr
+		f.writeAddr = oldWAddr
+		f.paletteChanged = false
+	}
+}
+
 func (f *Framebuffer) writePalette(value word) {
 	// 4 bits per color channel
 	r := uint8((value & 0b111100000000) >> 8)
@@ -116,6 +137,7 @@ func (f *Framebuffer) writePalette(value word) {
 	b = b << 4
 
 	f.palette[f.paletteSlot] = color.RGBA{r,g,b,0}
+	f.paletteChanged = true
 }
 
 func (f *Framebuffer) readCtl() word {

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
@@ -43,6 +45,7 @@ type Game struct{
 func (g *Game) Update() error {
 	startTime := time.Now()
 
+	framebuffer.startFrame()
 	for i := 0; i < g.stepsPerFrame; i++ {
 		err := cpu.step()
 		if err != nil {
@@ -57,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",
+			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

@@ -0,0 +1,118 @@
+#!/usr/bin/python3
+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
+    y = pix_h * frameindex
+    max_y = y + pix_h - 1
+
+    while y <= max_y:
+        x = 0
+        max_x = pix_w - 1
+        pixline = pixdata[y]
+        while x <= max_x:
+            px1 = pixline[x+0] & pixmask
+            px2 = pixline[x+1] & pixmask
+            px3 = pixline[x+2] & pixmask
+            px4 = pixline[x+3] & pixmask
+            px5 = pixline[x+4] & pixmask
+            px6 = pixline[x+5] & pixmask
+            px7 = pixline[x+6] & pixmask
+            px8 = pixline[x+7] & pixmask
+            vmem_word = (px1 << 28) | (px2 << 24) | (px3 << 20) | (px4 << 16) | \
+                        (px5 << 12) | (px6 << 8)  | (px7 << 4)  | px8
+
+            outfile.write(vmem_word.to_bytes(4, 'big'))
+            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):
+    if len(palette[0]) == 4:
+        for r,g,b,a in palette:
+            write_palette_word(outfile, r, g, b)
+    else:
+        for r,g,b in palette:
+            write_palette_word(outfile, r, g, b)
+
+
+def write_header(outfile):
+    magic = b'PIct'
+    mode = 1
+    outfile.write(magic);
+    outfile.write(mode.to_bytes(4, 'big'))
+
+
+def write_sprite_header(outfile):
+    magic = b'SPRT'
+    mode = 1
+    outfile.write(magic);
+    outfile.write(mode.to_bytes(4, 'big'))
+
+
+def write_pict_file(width, height, px, metadata, outfile):
+    print("processing as PICT file...")
+    if width != 640:
+        print("width must be 640, aborting")
+        sys.exit(1)
+    pixdata = list(px)
+    palette = metadata['palette']
+
+    if len(palette) != 16:
+        print("palette must have 16 colors, aborting")
+        sys.exit(0)
+
+    with open(outfile,'wb') as f:
+        write_header(f)
+        process_palette(f, palette)
+        process_pixdata(f, pixdata)
+
+
+def write_sprite_file(width, height, px, metadata, outfile):
+    print("processing as SPRT file with {} sprites...".format(height//sprite_height))
+    if width != sprite_width:
+        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 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=sprite_width, pix_h=height)
+
+
+if __name__ == '__main__':
+    if len(sys.argv) != 3:
+        print("Usage: {} <infile> <outfile>".format(sys.argv[0]))
+        sys.exit(1)
+
+    infile = sys.argv[1]
+    outfile = sys.argv[2]
+
+    r = png.Reader(infile)
+    p = r.read()
+    width, height, px, metadata = p
+    if width == 640:
+        write_pict_file(width, height, px, metadata, outfile)
+    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 {} pixels with 16 color palette.".format(sprite_width))
+

utils/serload.py

@@ -0,0 +1,393 @@
+#!/usr/bin/python3
+# vim: tabstop=8 expandtab shiftwidth=4 softtabstop=4
+#
+# Copyright 2021 Sebastian Lederer
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+#     http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+import sys
+import os
+import serial
+import time
+import random
+import platform
+import argparse
+
+blocksize = 32
+BEL = 7
+ACK = 6
+NAK = 21
+ENQ = 5
+SOH = 1
+STX = 2
+EOT = 4
+wordmask = 0xFFFFFFFF
+pattern = 0xAFFECAFE
+
+
+def get_default_device():
+    if platform.system() == 'Windows':
+        return 'COM4:'
+    else:
+        return '/dev/ttyUSB1'
+
+
+def checksum(databytes):
+    i = 0
+    cksum = 0
+    while i < len(databytes):
+        word =  databytes[i]   << 24 | \
+                databytes[i+1] << 16 | \
+                databytes[i+2] << 8  | \
+                databytes[i+3]
+        # print("word:{0:08x}".format(word))
+        i += 4
+
+        cksum = (((cksum + word) ^ pattern) << 1) & wordmask
+
+    return cksum
+
+
+def sendchar(char, ser):
+    ser.write(char.to_bytes(1, 'big'))
+
+
+def sendcommand(ser, cmd=b'L', verbose=False):
+    verbose = True
+    ser.write(cmd)
+    resp = ser.read_until()
+    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
+
+
+def send_size_header(ser, filesize):
+    ser.write(b'\x05')  # ENQ
+    resp = ser.read(1)
+    if resp != b'\x15': # NAK
+        # print("ENQ response:",str(resp))
+        ser.write(b'\x01') # SOH
+
+        databytes = filesize.to_bytes(4, 'big')
+        chksum = ~filesize & 0xFFFFFFFF
+
+        #print(str(databytes), len(databytes), type(filesize), filesize)
+        #print(str(chksum.to_bytes(4,'big')), len(databytes))
+
+        ser.write(databytes)
+        ser.write(chksum.to_bytes(4,'big'))
+
+        resp = ser.read(1)
+        if len(resp) == 0:
+            print("timeout waiting for ACK on size header")
+            return False
+        char = resp[0]
+        # print("response to size header:", str(resp), repr(char))
+        return char == ACK     # ACK
+    else:
+        print("Not using size header.")
+        return True
+
+
+def serload_bin(datafile, ser):
+    resp = sendcommand(ser)
+    if len(resp) == 0:
+        print("timeout sending 'L' command")
+        return
+
+    sentblocks = 0
+    resend = 0
+
+    data = []
+
+    if datafile.endswith('.mem'):
+        with open(datafile) as f:
+            for l in f.readlines():
+                b3 = l[0:8]
+                b2 = l[8:16]
+                b1 = l[16:24]
+                b0 = l[24:32]
+                data.extend([ int(b,2) for b in [b3,b2,b1,b0]])
+    else:
+        with open(datafile, 'rb') as f:
+            data = f.read()
+
+    filesize = len(data)
+
+    if filesize % blocksize > 0:
+        l = len(data)
+        pad = blocksize - (l % blocksize)
+
+        print("padding {} bytes with {} to {}".format(l, pad, l+pad))
+
+        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
+
+    while len(data) > 0:
+        block = data[0:32]
+        databytes = bytearray(block)
+
+        sendchar(STX, ser)
+        #print("block:",databytes)
+        chksum = checksum(databytes)
+        #print("checksum: {0:08x}".format(chksum))
+        #if random.randrange(2) == 0:
+        #    databytes[random.randrange(len(databytes))] = 0
+        ser.write(databytes)
+        #print(chksum.to_bytes(4, 'big'))
+        ser.write(chksum.to_bytes(4,'big'))
+
+        resp = ser.read(1)
+        if len(resp) == 0:
+            print("timeout waiting for ACK")
+            break
+        char = resp[0]
+
+        if char == ACK:
+            #print("ACK received")
+            sentblocks += 1
+            data = data[32:] # ack received, send next block
+        elif char == NAK:    # nak received, send same block
+            # print("NAK received")
+            resend += 1
+            pass
+        else:
+            print("garbage received: ",char)
+            print(ser.read(80))
+            break            # anything else, give up
+
+        print("{} blocks sent, {} retries".format(sentblocks, resend), end='\r')
+
+    sendchar(EOT, ser)
+    print()
+
+
+def word_from_bytes(b):
+    w = b[0] << 24 | b[1] << 16  | b[2] << 8 | b[3]
+    return w
+
+
+def read_word(ser):
+    b = ser.read(4)
+    if len(b) != 4:
+        return None
+    return word_from_bytes(b)
+
+
+def serdownload(fname, ser):
+    resp = sendcommand(ser, b'D')
+    if len(resp) == 0:
+        print("timeout sending 'D' command")
+        return
+
+    sendchar(BEL, ser);
+
+    resp = ser.read(1)
+    if len(resp) == 0:
+        print("Timeout receiving size header.")
+        return
+    if resp[0] != SOH:
+        print("Error receiving size header.", resp[0])
+        return
+
+    size = read_word(ser)
+    cksize = read_word(ser)
+    if (~cksize & 0xFFFFFFFF) != size:
+        print("Invalid size header received.")
+        return
+
+    sendchar(ACK, ser)
+
+    print("File size: {} bytes".format(size))
+
+    count = size
+    with open(fname, "wb") as f:
+        while count > 0:
+            startbyte = ser.read(1)
+            if len(startbyte) == 0:
+                print("Timeout receiving STX.")
+                return
+            if startbyte[0] != STX:
+                print("Error receiving STX.", resp[0])
+                return
+
+            block = ser.read(32)
+            if len(block) != 32:
+                print("Error receiving block")
+                return
+
+            cksum = read_word(ser)
+            if cksum is None:
+                print("Error receiving block checksum")
+                return
+
+            mysum = checksum(block)
+            if cksum != mysum:
+                print("Checksum error, retry block")
+                sendchar(NAK, ser)
+                continue
+
+            print(".", end="", flush=True)
+            count -= 32
+            f.write(block)
+            sendchar(ACK, ser)
+
+        resp = ser.read(1)
+        if len(resp) == 0:
+            print("Timeout receiving EOT.")
+        if resp[0] != EOT:
+            print("Error receiving EOT.", resp[0])
+
+        print("\nEnd of transmission, {} bytes received.".format(size))
+        f.truncate(size)
+        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__":
+    argparser = argparse.ArgumentParser(
+        description='transfer files from/to the Tridora-CPU')
+    argparser.add_argument('-d', '--device', help='serial device', default=get_default_device())
+    argparser.add_argument('command', choices=['get', 'put', 'mput', 'interactive'])
+    argparser.add_argument('filename', nargs='*')
+    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(filenames[0], ser)
+    elif cmd == 'put':
+        serload_bin(filenames[0], ser)
+    elif cmd == 'mput':
+        mput(filenames, ser)
+    elif cmd == 'interactive':
+        interactive(ser)
+    else:
+        print("should not get here")
+
+    #if cmd is not None:
+    #    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
@@ -239,7 +239,7 @@ def listvolumes(img):
     return firstvolume
 
  
-def listdir(img, part, verbose=False):
+def listdir(img, part, verbose=False, deleted=False):
     print("Directory of {}:".format(part.name))
     slotno = 0
     done = False
@@ -247,6 +247,8 @@ def listdir(img, part, verbose=False):
         slot = getdirslot(img, part, slotno)
         if (slot.flags & SlotFirst):
             print(slot.name, slot.sizeBytes, slotno)
+        elif deleted and (slot.flags & SlotDeleted):
+            print(slot.name, slot.sizeBytes, slotno, slot.generation)
         else:
             if verbose:
                 print(flags2str(slot.flags))
@@ -272,6 +274,21 @@ def findfile(img, part, name):
     return None
 
 
+def finddeleted(img, part, name, gen):
+    slotno = 0
+    done = False
+    while not done:
+        slot = getdirslot(img, part, slotno)
+        if slot.flags & SlotDeleted:
+            if slot.name == name and slot.generation == gen:
+                return slotno
+        slotno += 1
+        if (slot.flags & SlotEndScan) or (slotno >= part.dirSize):
+            done = True
+
+    return None
+
+
 def readfile(img, part, slotno):
     pos = part.startBlock * 512 + slotno * part.extentSize
     dirslot = getdirslot(img, part, slotno)
@@ -317,6 +334,24 @@ def readfromimg(img, pathname,outfilepath):
         f.write(data)
 
 
+def recoverfromimg(img, pathname, gen, outfilepath):
+    vol, filename = parsepath(img, pathname)
+    if vol is None:
+        return
+
+    listdir(img, vol, deleted=True)
+
+    slotno = finddeleted(img, vol, filename, gen)
+    if slotno is None:
+        print("File", filename,"not found with generation no", gen)
+        return
+
+    data = readfile(img, vol, slotno)
+
+    with open(outfilepath, "wb") as f:
+        f.write(data)
+
+
 def writetoimg(img, pathname, infilepath):
     vol, filename = parsepath(img, pathname)
     if vol is None:
@@ -337,8 +372,32 @@ def writetoimg(img, pathname, infilepath):
     putfile(infilepath, filename, img, vol, vol.startBlock, slotno)
 
 
-def create_image_with_stuff():
+def initfs(f, partno):
-    imgfile = "sdcard.img"
+    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
     extent_size = 8192
@@ -347,22 +406,27 @@ def create_image_with_stuff():
 
     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)
@@ -471,6 +535,11 @@ def create_image_with_stuff():
     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)
 
@@ -506,10 +575,10 @@ def create_image_with_stuff():
     # 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)
@@ -519,16 +588,13 @@ def create_image_with_stuff():
     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)
@@ -537,11 +603,29 @@ def create_image_with_stuff():
 
     slotnr = putfile("../examples/lines.pas", None , f, part, partstart, slotnr)
 
-    slotnr = putfile("../examples/viewpict.pas", None , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/pcmtest2.pas", None , f, part, partstart, slotnr)
-    # slotnr = putfile("viewpict.prog", None , f, part, partstart, slotnr)
+
-    slotnr = putfile("../examples/ara.pict", "ara.pict" , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/pictviewer.pas", None , f, part, partstart, slotnr)
-    slotnr = putfile("../examples/shinkansen.pict", "shinkansen.pict" , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/Toco_Toucan.pict", None , f, part, partstart, slotnr)
-    slotnr = putfile("../examples/snow_leopard.pict", "snow_leopard.pict" , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/shinkansen.pict", None , f, part, partstart, slotnr)
+    slotnr = putfile("../examples/snow_leopard.pict", None , 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)
 
@@ -555,11 +639,14 @@ if __name__ == "__main__":
         if sys.argv[1] == "get":
             f = open(sys.argv[2], "rb")
             readfromimg(f, sys.argv[3], sys.argv[4])
+        elif sys.argv[1] == "recover":
+            f = open(sys.argv[2], "rb")
+            recoverfromimg(f, sys.argv[3], int(sys.argv[4]), sys.argv[5])
         elif sys.argv[1] == "put":
             imgfile = open(sys.argv[2], "r+b")
             infilepath = sys.argv[3]
             destfilename = sys.argv[4]
             writetoimg(imgfile, destfilename, infilepath)
         elif sys.argv[1] == "createimg":
-            create_image_with_stuff()
+            create_image_with_stuff(sys.argv[2])
         sys.exit(0)

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)