diff --git a/doc/pascalprogramming.md b/doc/pascalprogramming.md index 454b46b..0d5e4cd 100644 --- a/doc/pascalprogramming.md +++ b/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. diff --git a/examples/animate.pas b/examples/animate.pas index 6ef73be..79cfc82 100644 --- a/examples/animate.pas +++ b/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; - roldX,roldY:integer; - r2oldX,r2oldY:integer; - r3oldX,r3oldY:integer; + lastX,lastY:integer; + rlastX,rlastY:integer; + r2lastX,r2lastY:integer; + r3lastX,r3lastY:integer; begin stickMan.x := 0; stickMan.y := 205; @@ -178,22 +178,22 @@ begin while not ConAvail do begin - oldX := stickMan.x; - oldY := stickMan.y; + lastX := stickMan.x; + lastY := stickMan.y; - roldX := rocket.x; - roldY := rocket.y; + rlastX := rocket.x; + rlastY := rocket.y; - r2oldX := rocket2.x; - r2oldY := rocket2.y; + r2lastX := rocket2.x; + r2lastY := rocket2.y; - r3oldX := rocket3.x; - r3oldY := rocket3.y; + r3lastX := rocket3.x; + r3lastY := rocket3.y; - PutSprite(roldX, roldY, rocket.frame[rocket.curFrame]); - PutSprite(r2oldX, r2oldY, rocket2.frame[rocket2.curFrame]); - PutSprite(r3oldX, r3oldY, rocket3.frame[rocket3.curFrame]); - PutSprite(oldX, oldY, stickMan.frame[stickMan.curFrame]); + PutSprite(rlastX, rlastY, rocket.frame[rocket.curFrame]); + PutSprite(r2lastX, r2lastY, rocket2.frame[rocket2.curFrame]); + PutSprite(r3lastX, r3lastY, rocket3.frame[rocket3.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(roldX, roldY, pic.pixeldata); - UndrawSprite(r2oldX, r2oldY, pic.pixeldata); - UndrawSprite(r3oldX, r3oldY, pic.pixeldata); + UndrawSprite(lastX, lastY, pic.pixeldata); + UndrawSprite(rlastX, rlastY, pic.pixeldata); + UndrawSprite(r2lastX, r2lastY, pic.pixeldata); + UndrawSprite(r3lastX, r3lastY, pic.pixeldata); end; end; diff --git a/lib/runtime.s b/lib/runtime.s index 9eb35d7..c90854d 100644 --- a/lib/runtime.s +++ b/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 diff --git a/lib/stdlib.inc b/lib/stdlib.inc index 5304403..d6531a9 100644 --- a/lib/stdlib.inc +++ b/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; diff --git a/tests/testmem.pas b/tests/testmem.pas new file mode 100644 index 0000000..d449161 --- /dev/null +++ b/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.