Package MemTest

Uses KbdCRT,Memory

Const
     Nil=Pointer(&HFFFF,&HFFFF)
     Nil16=&HF000
     SizMem=&H8000
Var
   TheMemBlock as Array[1..SizMem+&H20] of Byte
   TheMem as @BlockHead

Sub PrintTheMem
  CurBlock as @BlockHead
  NoBlock as Word
Enter
  PrintS "@TheMem=":PrintX High(@TheMem):
  PrintS "; FirstFreeBlock=":PrintX FirstFreeBlock
  PrintCR
  @CurBlock=@TheMem
  NoBlock=0
  Always
    PrintX NoBlock+=1
    PrintS " @=":PrintX High(@CurBlock)
    PrintS "; F=(":PrintX CurBlock.FPrec:PutCar ',':PrintX CurBlock.FSuiv:PutCar ')'
    PrintS "; M=(":PrintX CurBlock.Prec:PutCar ',':PrintX CurBlock.Suiv:PutCar ')'
    PrintS "; S=":PrintX CurBlock.Size
    PrintCR
  Awhile
    CurBlock.Suiv<>Nil16
  Do
    @CurBlock=Pointer(CurBlock.Suiv,0)
  Wend
Leave

P,Q,R as Pointer

Enter
  ClearScreen
\ Init FirstFreeBlock \
  FirstFreeBlock=High(@TheMemBlock)+1
  @TheMem=Pointer(FirstFreeBlock,0)
  TheMem.FPrec=TheMem.FSuiv=Nil16
  TheMem.Prec=TheMem.Suiv=Nil16
  TheMem.Size=SizMem/16
  PrintS "@TheMemBlock0=":PrintLX LongWord(@TheMemBlock):PrintCR
  PrintS "@@TheMem0=":PrintLX LongWord(@@TheMem):PrintCR
  PrintS "@TheMem0=":PrintLX LongWord(@TheMem):PrintCR
  PrintS "FirstFreeBlock0=":PrintX FirstFreeBlock:PrintCR
  P=MemAlloc(&H1234)
  Q=MemAlloc(&H5678)
  R=MemAlloc(&H1FFF)
  MemFree(Q)
  MemFree(P)
  MemFree(R)
  PrintTheMem
Leave