[Oberon] PO2013 - Show Heap Blocks

[Jörg]

John

In case you're interested, here the code:

PROCEDURE printf*(s: ARRAY OF CHAR; i1, i2: INTEGER; str: ARRAY OF CHAR);
	(* supported format %[length]type, type = d, i, x or s, and escape characters \n, \t *)
	VAR n, j, len, par, x: INTEGER; ch, nxCh: CHAR; imm: BOOLEAN;
	BEGIN
		imm := immediate; immediate := FALSE;
		par := 1; n := 0; ch := s[0];
		WHILE (ch # 0X) & (n < LEN(s)) DO
			j := n+1; nxCh := s[j];
			IF ch = "%" THEN 				(* handle format *)
				len := 0;
				WHILE ("0" <= nxCh) & (nxCh <= "9") DO len := len * 10 + ORD(nxCh) - ORD("0"); INC(j); nxCh := s[j] END;
				IF nxCh = "s" THEN String(str); INC(j)
				ELSIF (nxCh # "d") & (nxCh # "i") & (nxCh # "x") THEN Char("%")
				ELSE
					x := i2; IF par = 1 THEN x := i1 END; INC(par);
					IF nxCh = "x" THEN Hex(x) ELSE (* i, d *) Int(x, len) END;
					INC(j)
				END
			ELSIF ch = "\" THEN			(* handle escape characters *)
				IF nxCh = "n" THEN Ln; INC(j)
				ELSIF nxCh = "t" THEN Char(9X); INC(j)
				ELSE Char("\")
				END
			ELSE
				Char(ch)
			END;
			n := j; ch := s[n]
		END;
		immediate := imm
	END printf;

Am 19.06.20, 17:23 schrieb "Joerg" <joerg.straube at iaeth.ch>:

    John
    
    Seems like variadic but it is not.
    printf() has fix 4 arguments as I found out that this is enough for most cases. the first is the string with formatting commands, then two INTEGERs and one string (for a filename or so)
    
    If after a % there is a number, d, h or s it’s interpreted as argument else it’s just a %.
    
    br
    Jörg
    
    > Am 19.06.2020 um 16:56 schrieb John R. Strohm <strohm at airmail.net>:
    > 
    > Out.printf(), with VARIADIC arguments, in Oberon???
    > 
    > And that %d%) bothers me, for some reason...
    > 
    > --- joerg.straube at iaeth.ch wrote:
    > 
    > From: Jörg <joerg.straube at iaeth.ch>
    > To: ETH Oberon and related systems <oberon at lists.inf.ethz.ch>
    > Subject: Re: [Oberon] PO2013 - Show Heap Blocks
    > Date: Fri, 19 Jun 2020 10:37:08 +0200
    > 
    > Tomas
    > 
    > The following line will give you the stats as well:
    >  Out.printf(“Heap space used: %d bytes (=%d%)\n“,
    >    Kernel.allocated,
    >    Kernel.allocated * 100 DIV (Kernel.heapLim - Kernel.heapOrg), ““);
    > 
    > That‘s basically what System.Watch does.
    > 
    > br
    > Jörg
    > 
    > 
    >> Am 19.06.2020 um 10:12 schrieb Tomas Kral <thomas.kral at email.cz>:
    >> 
    >> 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>
    >> --
    >> Oberon at lists.inf.ethz.ch mailing list for ETH Oberon and related systems
    >> https://lists.inf.ethz.ch/mailman/listinfo/oberon
    > 
    > --
    > Oberon at lists.inf.ethz.ch mailing list for ETH Oberon and related systems
    > https://lists.inf.ethz.ch/mailman/listinfo/oberon
    > 
    > 
    > --
    > Oberon at lists.inf.ethz.ch mailing list for ETH Oberon and related systems
    > https://lists.inf.ethz.ch/mailman/listinfo/oberon