← DL-Pascal collectioncov12.pas
DOWNLOAD ORIGINAL FILE
{ DL-Pascal Coverage Section 12: Segments & Far Ptrs }
{ Two sections: }
{ A) Standard Pascal pointer features }
{ Near/far pointers, Seg/Ofs/Ptr/Addr, LongPtr }
{ B) Hardware absolute memory }
{ ROM easter egg, bank 1 RAM, bank 2 expansion RAM }
{ (bank 2 expansion: $8000-$FFFF = 32KB) }
{$D-C-R-}
PROGRAM Cov12;
USES Crt;
{ ======================================================= }
{ SECTION B: Hardware absolute memory declarations }
{ ======================================================= }
{ Bank 0: ROM card (read-only) }
VAR
copyRight : STRING ABSOLUTE 0:$FFE7; { Hans Larsson easter egg }
{ Bank 1: Normal RAM }
charBuf : ARRAY[0..255] OF Byte ABSOLUTE $0100; { char display }
gfxBuf : ARRAY[0..767] OF Byte ABSOLUTE $0200; { graphics }
memEnd : Word ABSOLUTE $0AB4; { RAM end }
b1lo : Byte ABSOLUTE 1:$0000; { bank 1 start }
b1hi : Byte ABSOLUTE 1:$FFFF; { bank 1 end }
{ Bank 2: Expansion RAM $8000-$FFFF (32KB) }
{ Confirmed by Piotr: ram2 maps to $8000-$FFFF in bank 2 }
ram2start : Byte ABSOLUTE 2:$8000;
ram2end : Byte ABSOLUTE 2:$FFFF;
{ Large static structures in expansion RAM }
{ This is the idiomatic use: named static variables }
expArray : ARRAY[0..255] OF Byte ABSOLUTE 2:$8000;
expArray2 : ARRAY[0..255] OF Byte ABSOLUTE 2:$8100;
TYPE
PByte = ^Byte;
PWord = ^Word;
PInt = ^Integer;
TBankArr = ARRAY[0..15] OF Byte;
{ Bank 1 exploration arrays }
VAR
b1arr : TBankArr ABSOLUTE 1:$0100; { alias of charBuf start }
VAR
i, j : Integer;
b : Byte;
bool : Boolean;
w : Word;
li : LongInt;
nb : PByte;
nw : PWord;
lp : LongPtr;
saved : TBankArr;
log : Text;
PROCEDURE WL(s : STRING);
BEGIN
WriteLn(log, s);
END;
PROCEDURE WLI(s : STRING; n : LongInt);
VAR t : STRING[20];
BEGIN
Str(n, t);
WL(s + t);
END;
PROCEDURE Check(msg : STRING; passed : Boolean);
BEGIN
IF passed THEN WL('OK ' + msg)
ELSE WL('FAIL ' + msg);
END;
{ ======================================================= }
{ SECTION A: Standard Pascal Pointer Features }
{ ======================================================= }
PROCEDURE TestNearPointers;
VAR
n : Integer;
r : Real;
pn : PInt;
pr : ^Real;
BEGIN
WL('=== A1: Near Pointers (^) ===');
WL(' Near pointers: bank 1 only, 2 bytes');
WL('');
{ Basic near pointer }
n := 42;
pn := Addr(n);
Check('Near non-nil', pn <> NIL);
Check('Near deref', pn^ = 42);
pn^ := 99;
Check('Near write', n = 99);
Check('Addr roundtrip', pn^ = n);
{ Heap allocation }
New(nb);
Check('New Byte non-nil', nb <> NIL);
nb^ := 200;
Check('New Byte deref', nb^ = 200);
nb^ := nb^ + 55;
Check('New Byte modify', nb^ = 255);
Dispose(nb);
New(nw);
nw^ := 12345;
Check('New Word deref', nw^ = 12345);
Dispose(nw);
{ Multiple allocations }
New(nb); nb^ := 1;
New(nw); nw^ := 2;
Check('Multi alloc b', nb^ = 1);
Check('Multi alloc w', nw^ = 2);
Dispose(nb);
Dispose(nw);
{ Real pointer }
New(pr);
pr^ := 3.14159;
Check('Real ptr deref', pr^ > 3.14);
Dispose(pr);
WLI(' MemAvail after: ', MemAvail);
END;
PROCEDURE TestSegOfs;
VAR
n : Integer;
oi : Integer; { Ofs result - doc says Word but try Integer }
BEGIN
WL('=== A2: Seg / Ofs / Ptr / Addr ===');
WL(' Seg() returns bank number (0..3) as Integer');
WL(' Ofs() DOC BUG: manual says Word but returns LongInt');
WL(' For bank 1 vars: Ofs = 65536 + raw_offset');
WL(' For bank 0/2 vars: Ofs = raw_offset only');
WL(' Use fp.offset via FarPtr record for true raw offset');
WL('');
n := 77;
{ Seg - returns bank number }
li := LongInt(Seg(n));
WLI(' Seg(n) = ', li);
Check('Seg(n) = 1', li = 1);
li := LongInt(Seg(copyRight));
WLI(' Seg(copyRight) = ', li);
Check('Seg(copyRight)=0', li = 0);
li := LongInt(Seg(charBuf));
WLI(' Seg(charBuf) = ', li);
Check('Seg(charBuf)=1', li = 1);
li := LongInt(Seg(gfxBuf));
WLI(' Seg(gfxBuf) = ', li);
Check('Seg(gfxBuf)=1', li = 1);
li := LongInt(Seg(ram2start));
WLI(' Seg(ram2start) = ', li);
Check('Seg(ram2start)=2', li = 2);
li := LongInt(Seg(ram2end));
WLI(' Seg(ram2end) = ', li);
Check('Seg(ram2end)=2', li = 2);
{ Ofs of local variable - runtime, returns Integer-sized value }
oi := Ofs(n);
WLI(' Ofs(n) runtime = ', oi);
Check('Ofs(n) > 0', oi > 0);
{ Ofs of ABSOLUTE vars - compile-time constant }
{ Cannot assign to any scalar - const range error }
{ Cast to LongInt for display only }
{ Observed values from actual run: }
{ charBuf ($0100 bank1): 65792 = $10100 }
{ gfxBuf ($0200 bank1): 66048 = $10200 }
{ copyRight ($FFE7 bank0): 65511 = $0FFE7 }
{ ram2start ($8000 bank2): 32768 = $08000 }
{ ram2end ($FFFF bank2): 65535 = $0FFFF }
{ Conclusion: Ofs() = segment*65536+offset }
{ EXCEPT bank2 acts as if segment=0, not 2 }
WLI(' Ofs(charBuf) = ', LongInt(Ofs(charBuf)));
WLI(' Ofs(gfxBuf) = ', LongInt(Ofs(gfxBuf)));
WLI(' Ofs(copyRight) = ', LongInt(Ofs(copyRight)));
WLI(' Ofs(ram2start) = ', LongInt(Ofs(ram2start)));
WLI(' Ofs(ram2end) = ', LongInt(Ofs(ram2end)));
WL(' DOC BUG: Ofs() returns LongInt not Word');
{ Ptr and Addr }
lp := Ptr(Seg(n), Ofs(n));
Check('Ptr non-nil', lp <> NIL);
lp := Addr(n);
Check('Addr non-nil', lp <> NIL);
lp := Addr(charBuf);
Check('Addr charBuf', lp <> NIL);
lp := Addr(ram2start);
Check('Addr ram2start', lp <> NIL);
END;
PROCEDURE TestFarPtrRecord;
TYPE
TFarPtr = RECORD
CASE b : Boolean OF
False : (p : LongPtr);
True : (offset, segment : Word);
END;
VAR
fp : TFarPtr;
fp2 : TFarPtr;
n : Integer;
BEGIN
WL('=== A3: FarPtr Record Structure ===');
WL(' Far pointer internal layout: Word(offset) + Word(segment)');
WL('');
n := 12345;
fp.p := Addr(n);
WLI(' fp.segment = ', fp.segment);
WLI(' fp.offset = ', fp.offset);
Check('FarPtr seg=1', fp.segment = 1);
Check('FarPtr ofs>0', fp.offset > 0);
Check('Seg matches', LongInt(fp.segment) = LongInt(Seg(n)));
Check('Ofs = raw offset', fp.offset = Ofs(n));
{ Far pointer to ROM }
fp2.p := Addr(copyRight);
WLI(' ROM seg = ', fp2.segment);
WLI(' ROM ofs = ', fp2.offset);
Check('ROM fp seg=0', fp2.segment = 0);
Check('ROM fp ofs=$FFE7', fp2.offset = Word(65511)); { $FFE7 }
{ Far pointer to expansion RAM }
fp2.p := Addr(ram2start);
WLI(' RAM2 seg = ', fp2.segment);
WLI(' RAM2 ofs = ', fp2.offset);
Check('RAM2 fp seg=2', fp2.segment = 2);
Check('RAM2 fp ofs=$8000', fp2.offset = Word(32768)); { $8000 }
WL(' DOC BUG: Ofs() returns LongInt not Word as documented');
WL(' fp.offset = true raw 16-bit offset within bank');
WL(' Ofs() = seg*65536+offset for bank 0/1, raw for bank 2');
END;
PROCEDURE TestLongPtr;
VAR
n : Integer;
lp2 : LongPtr;
BEGIN
WL('=== A4: LongPtr ===');
WL(' LongPtr: system far pointer, compatible with all ^^Type');
WL('');
n := 77;
lp2 := Addr(n);
Check('LongPtr non-nil', lp2 <> NIL);
{ LongPtr is compatible with Ptr() }
lp2 := Ptr(Seg(n), Ofs(n));
Check('LongPtr via Ptr', lp2 <> NIL);
{ LongPtr to different banks }
lp2 := Addr(copyRight);
Check('LongPtr ROM', lp2 <> NIL);
lp2 := Addr(ram2start);
Check('LongPtr RAM2', lp2 <> NIL);
lp2 := Addr(gfxBuf);
Check('LongPtr gfxBuf', lp2 <> NIL);
WL(' Note: ^^ dereference in expressions gives');
WL(' "Type not expected" in DL-Pascal 1.2.');
WL(' Use ABSOLUTE vars for direct memory access.');
WL(' Use Seg/Ofs/Ptr/Addr for address arithmetic.');
END;
{ ======================================================= }
{ SECTION B: Hardware Absolute Memory }
{ ======================================================= }
PROCEDURE TestEasterEgg;
BEGIN
WL('=== B1: Hans Larsson ROM Easter Egg ===');
WL(' Address: bank 0:$FFE7 (read-only ROM)');
WL(' Hidden copyright string placed by the author');
WL(' of DL-Pascal, Hans Larsson / Data-Larsson, 1989');
WL('');
WL(' Content: [' + copyRight + ']');
Check('Easter egg non-empty', Length(copyRight) > 0);
WLI(' Length: ', Length(copyRight));
Write(' Char codes:');
Write(log, ' Char codes:');
FOR i := 1 TO Length(copyRight) DO BEGIN
Write(Ord(copyRight[i]):4);
Write(log, Ord(copyRight[i]):4);
END;
WriteLn; WriteLn(log);
WL('');
WL(' Reading ROM via ABSOLUTE 0:$FFE7 â no pointer needed.');
WL(' The bank:offset syntax IS the far addressing.');
END;
PROCEDURE TestBank1RAM;
BEGIN
WL('=== B2: Bank 1 Normal RAM ===');
WL(' Bank 1: $0000-$FFFF (64KB), heap + variables');
WL('');
WLI(' memEnd ($0AB4) = ', memEnd);
Check('memEnd > 0', memEnd > 0);
WLI(' MemAvail = ', MemAvail);
Check('MemAvail > 0', MemAvail > 0);
{ Show bank 1 start/end values }
WLI(' 1:$0000 = ', b1lo);
WLI(' 1:$FFFF = ', b1hi);
{ charBuf alias }
WLI(' charBuf[0] = ', charBuf[0]);
Check('charBuf readable', True);
{ Write/read via ABSOLUTE }
FOR i := 0 TO 15 DO saved[i] := b1arr[i];
FOR i := 0 TO 15 DO b1arr[i] := Byte(i XOR $55);
bool := True;
FOR i := 0 TO 15 DO
IF b1arr[i] <> Byte(i XOR $55) THEN bool := False;
Check('Bank1 write/read', bool);
FOR i := 0 TO 15 DO b1arr[i] := saved[i];
Check('Bank1 restore', True);
WL(' Bank 1 key addresses:');
WL(' $0100: char display buffer (256 bytes)');
WL(' $0200: pixel graphics buffer (768 bytes)');
WL(' $0AB4: memEnd system variable');
END;
PROCEDURE TestBank2RAM;
VAR ok : Boolean;
BEGIN
WL('=== B3: Bank 2 Expansion RAM ($8000-$FFFF) ===');
WL(' Confirmed by Piotr: ram2 maps $8000-$FFFF in bank 2');
WL(' 32KB of additional static storage');
WL('');
WLI(' ram2start (2:$8000) = ', ram2start);
WLI(' ram2end (2:$FFFF) = ', ram2end);
{ Save }
FOR i := 0 TO 15 DO saved[i] := expArray[i];
{ Write/read test }
FOR i := 0 TO 15 DO expArray[i] := Byte(i * 17);
ok := True;
FOR i := 0 TO 15 DO
IF expArray[i] <> Byte(i * 17) THEN ok := False;
Check('Bank2 write/read', ok);
WLI(' expArray[0] = ', expArray[0]);
WLI(' expArray[15] = ', expArray[15]);
{ XOR pattern across 256 bytes }
FOR i := 0 TO 255 DO expArray[i] := Byte(i XOR $A5);
ok := True;
FOR i := 0 TO 255 DO
IF expArray[i] <> Byte(i XOR $A5) THEN ok := False;
Check('Bank2 256 bytes', ok);
{ Second array at $8100 }
FOR i := 0 TO 15 DO expArray2[i] := Byte(i + 100);
ok := True;
FOR i := 0 TO 15 DO
IF expArray2[i] <> Byte(i + 100) THEN ok := False;
Check('Bank2 $8100', ok);
{ Restore }
FOR i := 0 TO 15 DO expArray[i] := saved[i];
FOR i := 16 TO 255 DO expArray[i] := 0;
FOR i := 0 TO 15 DO expArray2[i] := 0;
Check('Bank2 restore', True);
WL('');
WL(' Idiomatic use: named static ABSOLUTE variables');
WL(' e.g. large lookup tables, P-machine stack,');
WL(' graphics buffers, language runtime data.');
WL(' Total addressable: 64KB(bank1) + 32KB(bank2) = 96KB');
END;
PROCEDURE TestAbsoluteAliasing;
VAR
alias1 : Byte ABSOLUTE $0100;
alias2 : Byte ABSOLUTE $0101;
orig1, orig2 : Byte;
BEGIN
WL('=== B4: Absolute Variable Aliasing ===');
WL(' Multiple variables can alias the same address.');
WL(' Write via one name, read via another.');
WL('');
orig1 := alias1; orig2 := alias2;
alias1 := $AB;
Check('Alias write', charBuf[0] = $AB);
charBuf[0] := $CD;
Check('Alias read', alias1 = $CD);
alias2 := $EF;
Check('Alias2 write', charBuf[1] = $EF);
alias1 := orig1; alias2 := orig2;
Check('Alias restore', True);
WL(' ABSOLUTE $XXXX = bank 1 (default)');
WL(' ABSOLUTE N:$XXXX = bank N explicitly');
WL(' ABSOLUTE 0:$FFE7 = ROM (read-only in practice)');
WL(' ABSOLUTE 2:$8000 = expansion RAM start');
END;
PROCEDURE ShowMemoryMap;
BEGIN
WL('=== Memory Map: Casio PB-2000C ===');
WL('');
WL(' Bank 0: ROM card 0:$0000-$FFFF 64KB RO');
WL(' Bank 1: Normal RAM 1:$0000-$FFFF 64KB RW');
WL(' Bank 2: Exp. RAM 2:$8000-$FFFF 32KB RW');
WL(' Bank 3: ROM+exp 3:$0000-$FFFF 64KB');
WL('');
WL(' Pointer types:');
WL(' Near ptr (^) 2 bytes bank 1 only');
WL(' Far ptr (^^) 4 bytes any bank');
WL(' LongPtr system far pointer type');
WL('');
WL(' Key addresses:');
WL(' $0100 char display buffer (bank 1)');
WL(' $0200 pixel graphics buf (bank 1)');
WL(' $0AB4 memEnd (bank 1)');
WL(' 0:$FFE7 Hans Larsson easter egg (ROM)');
WL(' 2:$8000 expansion RAM start');
WL(' 2:$FFFF expansion RAM end');
WL('');
WL(' Total addressable with expansion: 96KB');
WL(' (64KB bank1 + 32KB bank2)');
WL('');
WL(' DOC BUG: Ofs() return type:');
WL(' Manual says Word (0..$FFFF) - INCORRECT');
WL(' Actually returns LongInt linear address');
WL(' bank1 vars: Ofs = 65536 + raw_offset');
WL(' bank0 vars: Ofs = raw_offset');
WL(' bank2 vars: Ofs = raw_offset (not 2*65536+ofs)');
WL(' For true raw offset: use FarPtr record fp.offset');
WL(' Note: ^^ dereference not usable in expressions.');
WL(' Use ABSOLUTE declarations for direct access.');
END;
{ ======== MAIN ======== }
BEGIN
Assign(log, '0:cov12.log');
Rewrite(log);
WL('=== Cov12: Segments, Far Pointers & Memory ===');
WL('');
WL('--- SECTION A: Standard Pascal Pointer Features ---');
WL('');
TestNearPointers; WL(''); ClrScr;
TestSegOfs; WL(''); ClrScr;
TestFarPtrRecord; WL(''); ClrScr;
TestLongPtr; WL(''); ClrScr;
WL('--- SECTION B: Hardware Absolute Memory ---');
WL('');
TestEasterEgg; WL(''); ClrScr;
TestBank1RAM; WL(''); ClrScr;
TestBank2RAM; WL(''); ClrScr;
TestAbsoluteAliasing; WL(''); ClrScr;
ShowMemoryMap; WL('');
WL('=== Cov12 complete ===');
Close(log);
END.