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