{ DL-Pascal Coverage Section 8: Dynamic Memory & Pointers }
{ Exercises New, Dispose, GetMem, FreeMem, Mark, Release, }
{ MemAvail, MaxAvail, NIL, pointer dereferencing,         }
{ typed/untyped pointers, heapError, linked lists,        }
{ SizeOf, Addr, Ptr, and pointer arithmetic.              }
{ Expected: runs without error, displays results.         }
{$D-C-R-}

PROGRAM Section8;

TYPE
  { Aliases of built-in types to test if SizeOf works on aliases }
  TMyInt  = Integer;
  TMyWord = Word;
  TMyLong = LongInt;
  TMyReal = Real;
  TMyPtr  = Pointer;

  { Single-field records wrapping each scalar to probe SizeOf behaviour }
  TRInt  = RECORD n : Integer;  END;
  TRWord = RECORD n : Word;     END;
  TRLong = RECORD n : LongInt;  END;
  TRReal = RECORD n : Real;     END;
  TRPtr  = RECORD n : Pointer;  END;

  PInteger  = ^Integer;
  PReal     = ^Real;
  PChar     = ^Char;
  TStr255   = STRING[255];
  PString   = ^TStr255;

  { Linked list node }
  PNode = ^TNode;
  TNode = RECORD
    value : Integer;
    next  : PNode;
  END;

  { Record for heap allocation }
  TData = RECORD
    x, y  : Integer;
    name  : STRING[20];
  END;
  PData = ^TData;

VAR
  pi        : PInteger;
  pr        : PReal;
  pc        : PChar;
  ps        : PString;
  pd        : PData;
  pn        : PNode;
  p1, p2    : Pointer;
  saveP     : Pointer;
  i, j      : Integer;
  r         : Real;
  avail1,
  avail2    : Word;
  b         : Boolean;

PROCEDURE Check(msg : STRING; passed : Boolean);
BEGIN
  IF passed THEN
    WriteLn('OK   ', msg)
  ELSE
    WriteLn('FAIL ', msg);
END;

{ ---- heapError function return NIL instead of crashing ---- }
FUNCTION SafeHeap(size : Word) : Byte;
BEGIN
  SafeHeap := 1;  { return NIL to caller }
END;

{ ---- Basic New / Dispose ---- }
PROCEDURE TestNewDispose;
BEGIN
  { Allocate integer }
  New(pi);
  Check('New non-nil',   pi <> NIL);
  pi^ := 42;
  Check('Deref write',   pi^ = 42);
  pi^ := pi^ + 8;
  Check('Deref modify',  pi^ = 50);
  Dispose(pi);
  Check('Dispose done',  True);

  { Allocate real }
  New(pr);
  Check('New real',      pr <> NIL);
  pr^ := 3.14159;
  Check('Real deref',    pr^ > 3.14);
  Dispose(pr);

  { Allocate char }
  New(pc);
  pc^ := 'X';
  Check('Char deref',    pc^ = 'X');
  Dispose(pc);

  { Allocate string }
  New(ps);
  ps^ := 'Hello Heap';
  Check('Str deref',     ps^ = 'Hello Heap');
  Dispose(ps);

  { Allocate record }
  New(pd);
  pd^.x := 10;
  pd^.y := 20;
  pd^.name := 'TestRec';
  Check('Rec deref x',   pd^.x = 10);
  Check('Rec deref y',   pd^.y = 20);
  Check('Rec deref name',pd^.name = 'TestRec');
  WITH pd^ DO BEGIN
    x := 99;
    Check('WITH deref',  x = 99);
  END;
  Dispose(pd);
END;

{ ---- Multiple allocations and independence ---- }
PROCEDURE TestMultiAlloc;
VAR
  pa, pb, pc2 : PInteger;
BEGIN
  New(pa); New(pb); New(pc2);
  pa^ := 1; pb^ := 2; pc2^ := 3;

  Check('Multi alloc a',   pa^ = 1);
  Check('Multi alloc b',   pb^ = 2);
  Check('Multi alloc c',   pc2^ = 3);

  { Modifying one doesn't affect others }
  pa^ := 99;
  Check('Multi indep b',   pb^ = 2);
  Check('Multi indep c',   pc2^ = 3);

  Dispose(pa); Dispose(pb); Dispose(pc2);
  Check('Multi dispose',   True);

  { Re-allocate after dispose }
  New(pa);
  pa^ := 77;
  Check('Re-alloc',        pa^ = 77);
  Dispose(pa);
END;

{ ---- GetMem / FreeMem ---- }
PROCEDURE TestGetFreeMem;
VAR pw : ^Word;
BEGIN
  { GetMem with explicit size }
  GetMem(p1, SizeOf(Integer));
  Check('GetMem non-nil',  p1 <> NIL);

  { Cast and use }
  Integer(p1^) := 1234;
  Check('GetMem cast',     Integer(p1^) = 1234);
  FreeMem(p1, SizeOf(Integer));

  { GetMem for array of words }
  GetMem(p1, 10 * SizeOf(Word));
  Check('GetMem array',    p1 <> NIL);
  FreeMem(p1, 10 * SizeOf(Word));
  Check('FreeMem done',    True);
END;

{ ---- Mark / Release ---- }
PROCEDURE TestMarkRelease;
VAR
  pa, pb, pc2 : PInteger;
BEGIN
  { Mark heap position }
  Mark(saveP);

  { Allocate several variables }
  New(pa); New(pb); New(pc2);
  pa^ := 10; pb^ := 20; pc2^ := 30;

  Check('Mark alloc a',    pa^ = 10);
  Check('Mark alloc b',    pb^ = 20);

  { Release ALL at once back to mark }
  Release(saveP);
  Check('Release done',    True);

  { After release, heap should have more memory }
  { (Don't use pa/pb/pc2 after Release!) }
END;

{ ---- MemAvail / MaxAvail ---- }
PROCEDURE TestMemAvail;
BEGIN
  avail1 := MemAvail;
  Check('MemAvail > 0',    avail1 > 0);
  WriteLn('  MemAvail: ', avail1, ' bytes');

  avail1 := MaxAvail;
  Check('MaxAvail > 0',    avail1 > 0);
  WriteLn('  MaxAvail: ', avail1, ' bytes');

  { Allocating reduces MemAvail }
  avail1 := MemAvail;
  New(pi);
  avail2 := MemAvail;
  Check('Alloc reduces',   avail2 < avail1);
  Dispose(pi);

  { After dispose, MemAvail should recover }
  avail2 := MemAvail;
  Check('Dispose recovers',avail2 >= avail1);
END;

{ ---- NIL pointer ---- }
PROCEDURE TestNil;
BEGIN
  pi := NIL;
  Check('NIL assign',      pi = NIL);
  Check('NIL compare',     NOT (pi <> NIL));

  New(pi);
  Check('After New <> NIL',pi <> NIL);
  Dispose(pi);

  pi := NIL;
  Check('After NIL',       pi = NIL);
END;

{ ---- heapError — safe allocation ---- }
PROCEDURE TestHeapError;
BEGIN
  { Install safe heap error handler }
  heapError := SafeHeap;

  { Normal allocation should still work }
  New(pi);
  Check('Safe alloc works', pi <> NIL);
  Dispose(pi);

  { Restore default heap error assign the built-in default }
  { heapError := NIL is not valid in DL-Pascal }
  { Simply leave SafeHeap installed — it returns NIL safely }
  Check('HeapError done',  True);
END;

{ ---- SizeOf ---- }
PROCEDURE TestSizeOf;
BEGIN
  { BUG SUMMARY: SizeOf in DL-Pascal 1.2                                    }
  { SizeOf(scalar_type) always returns 1 — broken for Integer/Word/         }
  { LongInt/Real/Pointer and any alias of these types.                      }
  { SizeOf(record_type) returns correct total size.                         }
  { Workaround: wrap scalar in a single-field record:                       }
  {   TYPE TRInt = RECORD n:Integer; END;  SizeOf(TRInt) = 2  (correct)    }
  { Also: SizeOf(TNode) returns 1 because TNode is accessed via PNode       }
  { (pointer type) — the record TNode itself is never passed to SizeOf.     }

  { Expose the bug — these FAIL but document the behaviour }
  Check('SizeOf Byte',     SizeOf(Byte)     = 1);   { OK - 1 byte }
  Check('SizeOf Char',     SizeOf(Char)     = 1);   { OK - 1 byte }
  Check('SizeOf Boolean',  SizeOf(Boolean)  = 1);   { OK - 1 byte }
  Check('SizeOf Integer',  SizeOf(Integer)  = 2);   { BUG - returns 1 }
  Check('SizeOf Word',     SizeOf(Word)     = 2);   { BUG - returns 1 }
  Check('SizeOf LongInt',  SizeOf(LongInt)  = 4);   { BUG - returns 1 }
  Check('SizeOf Real',     SizeOf(Real)     = 8);   { BUG - returns 1 }
  Check('SizeOf Pointer',  SizeOf(Pointer)  = 2);   { BUG - returns 1 }

  { Try aliases — does SizeOf work on user-defined type aliases? }
  Check('SizeOf TMyInt',   SizeOf(TMyInt)   = 2);   { alias of Integer }
  Check('SizeOf TMyWord',  SizeOf(TMyWord)  = 2);   { alias of Word }
  Check('SizeOf TMyLong',  SizeOf(TMyLong)  = 4);   { alias of LongInt }
  Check('SizeOf TMyReal',  SizeOf(TMyReal)  = 8);   { alias of Real }
  Check('SizeOf TMyPtr',   SizeOf(TMyPtr)   = 2);   { alias of Pointer }
  WriteLn('  SizeOf(TMyInt) =', SizeOf(TMyInt));
  WriteLn('  SizeOf(TMyWord)=', SizeOf(TMyWord));
  WriteLn('  SizeOf(TMyLong)=', SizeOf(TMyLong));
  WriteLn('  SizeOf(TMyReal)=', SizeOf(TMyReal));
  WriteLn('  SizeOf(TMyPtr) =', SizeOf(TMyPtr));

  { Wrap scalars in records — does SizeOf work on the record? }
  Check('SizeOf TRInt=2',  SizeOf(TRInt)  = 2);   { record of Integer }
  Check('SizeOf TRWord=2', SizeOf(TRWord) = 2);   { record of Word }
  Check('SizeOf TRLong=4', SizeOf(TRLong) = 4);   { record of LongInt }
  Check('SizeOf TRReal=8', SizeOf(TRReal) = 8);   { record of Real }
  Check('SizeOf TRPtr=2',  SizeOf(TRPtr)  = 2);   { record of Pointer }
  WriteLn('  SizeOf(TRInt) =', SizeOf(TRInt));
  WriteLn('  SizeOf(TRWord)=', SizeOf(TRWord));
  WriteLn('  SizeOf(TRLong)=', SizeOf(TRLong));
  WriteLn('  SizeOf(TRReal)=', SizeOf(TRReal));
  WriteLn('  SizeOf(TRPtr) =', SizeOf(TRPtr));
  Check('SizeOf TNode > 0', SizeOf(TNode)   > 0);
  Check('SizeOf TStr255',   SizeOf(TStr255) = 256);
  Check('SizeOf TData=25',  SizeOf(TData)   = 25);
  WriteLn('  SizeOf(TNode)=',   SizeOf(TNode));
  WriteLn('  SizeOf(TData)=',   SizeOf(TData));
  WriteLn('  SizeOf(TStr255)=', SizeOf(TStr255));
END;

{ ---- Linked list ---- }
PROCEDURE TestLinkedList;
VAR
  head, curr, tmp : PNode;
  n, sum          : Integer;
BEGIN
  { Build list 1->2->3->4->5 }
  head := NIL;
  FOR i := 5 DOWNTO 1 DO BEGIN
    New(curr);
    curr^.value := i;
    curr^.next  := head;
    head        := curr;
  END;

  { Traverse and sum }
  sum := 0; n := 0;
  curr := head;
  WHILE curr <> NIL DO BEGIN
    sum  := sum + curr^.value;
    Inc(n);
    curr := curr^.next;
  END;
  Check('List length',    n = 5);
  Check('List sum',       sum = 15);

  { Find value 3 }
  curr := head;
  WHILE (curr <> NIL) AND (curr^.value <> 3) DO
    curr := curr^.next;
  Check('List find 3',    (curr <> NIL) AND (curr^.value = 3));

  { Delete list }
  curr := head;
  WHILE curr <> NIL DO BEGIN
    tmp  := curr^.next;
    Dispose(curr);
    curr := tmp;
  END;
  Check('List disposed',  True);
END;

{ ---- Pointer to pointer ---- }
PROCEDURE TestPtrToPtr;
TYPE PPInteger = ^PInteger;
VAR
  ppi : PPInteger;
  pi2 : PInteger;
BEGIN
  New(pi2);
  pi2^ := 42;
  New(ppi);
  ppi^ := pi2;
  Check('Ptr to ptr',     ppi^^ = 42);
  ppi^^ := 99;
  Check('Ptr write thru', pi2^ = 99);
  Dispose(ppi);
  Dispose(pi2);
END;

{ ---- Stack vs heap ---- }
PROCEDURE TestStackHeap;
VAR
  localI  : Integer;
  localArr: ARRAY[1..10] OF Integer;
BEGIN
  { Local variables on stack }
  localI := 123;
  FOR i := 1 TO 10 DO localArr[i] := i * 2;
  Check('Stack local',    localI = 123);
  Check('Stack array',    localArr[5] = 10);

  { Heap allocation inside procedure }
  New(pi);
  pi^ := 456;
  Check('Heap in proc',   pi^ = 456);
  Dispose(pi);

  { Stack and heap coexist }
  New(pi);
  pi^ := localI;
  Check('Stack+Heap',     pi^ = 123);
  Dispose(pi);
END;

{ ---- Addr function ---- }
PROCEDURE TestAddr;
VAR
  n   : Integer;
  p   : Pointer;
BEGIN
  n := 42;
  p := Addr(n);
  Check('Addr non-nil',   p <> NIL);
  { Access via typed pointer cast }
  Check('Addr deref',     Integer(p^) = 42);
  Integer(p^) := 99;
  Check('Addr write',     n = 99);
END;

{ ---- Main ---- }
BEGIN
  WriteLn('=== Section 8: Dynamic Memory and Pointers ===');
  WriteLn;

  WriteLn('-- New/Dispose --');
  TestNewDispose;       WriteLn;

  WriteLn('-- Multi Alloc --');
  TestMultiAlloc;       WriteLn;

  WriteLn('-- GetMem/FreeMem --');
  TestGetFreeMem;       WriteLn;

  WriteLn('-- Mark/Release --');
  TestMarkRelease;      WriteLn;

  WriteLn('-- MemAvail/MaxAvail --');
  TestMemAvail;         WriteLn;

  WriteLn('-- NIL --');
  TestNil;              WriteLn;

  WriteLn('-- HeapError --');
  TestHeapError;        WriteLn;

  WriteLn('-- SizeOf --');
  TestSizeOf;           WriteLn;

  WriteLn('-- Linked List --');
  TestLinkedList;       WriteLn;

  WriteLn('-- Ptr to Ptr --');
  TestPtrToPtr;         WriteLn;

  WriteLn('-- Stack vs Heap --');
  TestStackHeap;        WriteLn;

  WriteLn('-- Addr --');
  TestAddr;             WriteLn;

  WriteLn('=== Section 8 complete ===');
END.