[Oberon] PO2013 - Show Heap Blocks

[Tomas Kral]

Hi,

This is my understanding so far, it stats the heap.
It also shows free block last to the limit, because heap ends 16 bytes
earlier, so is not MOD 32.

MODULE Heap; (*TK 14.6.2020 show heap blocks*)
  IMPORT S := SYSTEM, Kernel, Out;

  VAR heapOrg, MemLim, heapLim: INTEGER;

  PROCEDURE Scan*;
    VAR p, q, mark, tag, size, used, free: LONGINT;
  BEGIN p := heapOrg; used := 0; free := 0;
    Out.Hex(heapOrg); Out.Ln; (*60000H 4-bit colour display*)
    Out.Hex(heapLim); Out.Ln; (*9FEF0H*)
    REPEAT S.GET(p+4, mark); q := p; (*mark: 0 used, -1 freed, >0 marked*)
      IF mark = -1 THEN S.GET(p, size)
      ELSE S.GET(p, tag); S.GET(tag, size); (*size := p - q*) END ;
      IF (size MOD 32 # 0) & (size MOD 64 # 0) & (size MOD 128 # 0) & (size MOD 256 # 0) THEN
        Out.Hex(p); Out.Hex(size); Out.Hex(mark); Out.Ln (*free block to 9FEF0H*)
      END ;
      IF mark > 0 THEN INC(used, size) (*none after kernel scan*)
      ELSIF mark = 0 THEN INC(used, size) 
      ELSIF mark = -1 THEN INC(free, size) END ;
      INC(p, size)
    UNTIL p >= heapLim(*-30000H*) ;
    Out.Int(used, 8); (*value*) Out.Int(used*100 DIV free, 3); (*percentage*)
    Out.Hex(free+used); Out.Ln (*3FEF0 = 9FEF0H-60000H, or less if fragmented*)
  END Scan;

  PROCEDURE Lists*;
	VAR p, list0, list1, list2, list3: INTEGER;
  BEGIN
    p := S.ADR(Kernel.MemLim);
    S.GET(p+8, list0);
    S.GET(p+12, list1);
    S.GET(p+16, list2);
    S.GET(p+20, list3);
    Out.Hex(list3); Out.Hex(list2); Out.Hex(list1); Out.Hex(list0); Out.Ln
  END Lists;

BEGIN S.GET(12, MemLim); S.GET(24, heapOrg); heapLim := MemLim
END Heap.

Heap.Scan
Heap.Lists


-- 
Tomas Kral <thomas.kral at email.cz>