runtime/stdlib: add MaxAvail function

doc/pascalprogramming.md

@@ -111,7 +111,7 @@ If heap allocation fails, *new* does not return and instead causes a runtime err
 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.
+The function *MaxAvail* returns the size of the largest contiguous block of available heap memory in bytes.
 
 ## 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.
@@ -236,7 +236,7 @@ In Wirth Pascal, labels must be numbers. Other Pascal dialects also allow normal
 Tridora-Pascal only allows identifiers as labels.
 
 ## Units
-Units are the method to create libraries in Tridora-Pascal, that is, codes module that can
+Units are the method to create libraries in Tridora-Pascal, that is, code modules that can
 be reused in other programs.
 
 Tridora-Pascal follows the unit syntax that has been established in UCSD-Pascal and is also
@@ -275,7 +275,7 @@ in the *SYSTEM* volume.
 A unit implementation file should start with a *UNIT* statement instead of a *PROGRAM*
 statement.
 
-It should be compiled, not assembled.
+It should only be compiled, not assembled.
 
 When building a program that uses units, the assembler will include an assembly language
 file for each unit.

examples/animate.pas

@@ -5,7 +5,7 @@ type PictData = record
 		magic,mode:integer;
 		palette: array [0..15] of integer;
 		pixeldata: array [0..31999] of integer;
-	end;
+     end;
 
      Sprite = record
      	x,y:integer;
@@ -131,10 +131,10 @@ end;
 
 procedure animLoop;
 var i:integer;
-    oldX,oldY:integer;
+    lastX,lastY:integer;
-    roldX,roldY:integer;
+    rlastX,rlastY:integer;
-    r2oldX,r2oldY:integer;
+    r2lastX,r2lastY:integer;
-    r3oldX,r3oldY:integer;
+    r3lastX,r3lastY:integer;
 begin
 	stickMan.x := 0;
 	stickMan.y := 205;
@@ -178,22 +178,22 @@ begin
 
 	while not ConAvail do
 	begin
-		oldX := stickMan.x;
+		lastX := stickMan.x;
-		oldY := stickMan.y;
+		lastY := stickMan.y;
 
-		roldX := rocket.x;
+		rlastX := rocket.x;
-		roldY := rocket.y;
+		rlastY := rocket.y;
 
-		r2oldX := rocket2.x;
+		r2lastX := rocket2.x;
-		r2oldY := rocket2.y;
+		r2lastY := rocket2.y;
 
-		r3oldX := rocket3.x;
+		r3lastX := rocket3.x;
-		r3oldY := rocket3.y;
+		r3lastY := rocket3.y;
 
-		PutSprite(roldX, roldY, rocket.frame[rocket.curFrame]);
+		PutSprite(rlastX, rlastY, rocket.frame[rocket.curFrame]);
-		PutSprite(r2oldX, r2oldY, rocket2.frame[rocket2.curFrame]);
+		PutSprite(r2lastX, r2lastY, rocket2.frame[rocket2.curFrame]);
-		PutSprite(r3oldX, r3oldY, rocket3.frame[rocket3.curFrame]);
+		PutSprite(r3lastX, r3lastY, rocket3.frame[rocket3.curFrame]);
-		PutSprite(oldX, oldY, stickMan.frame[stickMan.curFrame]);
+		PutSprite(lastX, lastY, stickMan.frame[stickMan.curFrame]);
 
 		animateSprite(rocket);
 		animateSprite(rocket2);
@@ -203,10 +203,10 @@ begin
 		Delay(10);
 		WaitVSync;
 
-		UndrawSprite(oldX, oldY, pic.pixeldata);
+		UndrawSprite(lastX, lastY, pic.pixeldata);
-		UndrawSprite(roldX, roldY, pic.pixeldata);
+		UndrawSprite(rlastX, rlastY, pic.pixeldata);
-		UndrawSprite(r2oldX, r2oldY, pic.pixeldata);
+		UndrawSprite(r2lastX, r2lastY, pic.pixeldata);
-		UndrawSprite(r3oldX, r3oldY, pic.pixeldata);
+		UndrawSprite(r3lastX, r3lastY, pic.pixeldata);
 	end;
 end;
 

lib/runtime.s

@@ -1792,6 +1792,38 @@ MAX_XT:
 	FPADJ 4
 	RET
 
+; find largest free chunk on heap
+; args: none
+; returns: size of largest free chunk in bytes
+MAXAVAIL:
+	FPADJ -4
+	LOADC 0
+	STORE 0	; start with zero as result
+
+	LOADCP _HEAP_ANCHOR
+MXAV_L:
+	DUP	; dup chunk ptr for later
+	INC 4	; move to size field
+	LOADI	; load chunk size
+	LOAD 0  ; compare with current result value
+	CMPU.S0 LE ; compare with keeping first arg on stack
+	CBRANCH MXAV_NEXT ; if smaller or equal, no change
+	STORE 0		; else store as new value
+	BRANCH MXAV_NEXT2
+MXAV_NEXT:
+	DROP
+MXAV_NEXT2:
+	LOADI	; load next ptr
+	DUP
+	LOADCP _HEAP_ANCHOR ; compare with anchor
+	CMPU NE
+	CBRANCH MXAV_L       ; if not equal, loop
+MXAV_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

lib/stdlib.inc

@@ -150,6 +150,7 @@ 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;
+function MaxAvail:integer; external;
 
 (* from stdlib *)
 function copy(s:string[256];index,count:integer):string[256]; external;

tests/testmem.pas

@@ -0,0 +1,18 @@
+program testmem;
+var s1:^string[2048];
+    s2:^string[2048];
+begin
+        writeln(MemAvail);
+        writeln(MaxAvail);
+
+        writeln('new s1 and s2');
+        new(s1);
+        new(s2);
+        writeln(MemAvail);
+        writeln(MaxAvail);
+
+        writeln('dispose s1');
+        dispose(s1);
+        writeln(MemAvail);
+        writeln(MaxAvail);
+end.