[Oberon] FPGA - Bitmap self-allocation

[Tomas Kral]

Hi,

I was toying with bitmaps and heap allocation, also rereading old
posts on type tags here.

I was tempted and coded this example of bitmap able to self allocate
itself on heap. Possibly not perfect but seems doing things.

MODULE BM; (*TK 20.9.2017, self allocating bitmap example*)
 IMPORT SYSTEM, Kernel, Texts, Oberon;

 TYPE
  Tag = POINTER TO TypeDesc;
  TypeDesc = RECORD 
    size: INTEGER;
    ext: ARRAY 3 OF INTEGER;
    ptr, mk: INTEGER;
    next: Tag
  END; (* see Project Oberon, figure 8.8 *)

  Address = POINTER TO RECORD END; (* this pointer will be redefined by
  TypeTag *) 
  Bitmap* = POINTER TO RECORD
   tag: TypeDesc; (* type descriptor of the pointer "base" *)
   base: Address;
   width, height: INTEGER
  END;

  VAR 
    W: Texts.Writer; B*: Bitmap;
    first: Tag;

 PROCEDURE New(w, h: INTEGER): Bitmap;
  VAR b: Bitmap; t: Tag;
 BEGIN
  NEW(b); IF b # NIL THEN
   b.width := w; b.height := h;

   (* the following code defines bitmap type tag *)

   b.tag.size := (w+7) DIV 8 * h; (* bitmap size in bytes *)
   b.tag.ext[0] := 0; b.tag.ext[1] := 0; b.tag.ext[2] := 0;
   b.tag.ptr := -1;   (* type has no pointers, important for GC *)
   b.tag.mk := 0;     (* GC marks bitmap for collection when it stops
   being referenced *)

   (* allocate memory and define its type *)
   Kernel.New(SYSTEM.VAL(INTEGER, b.base), SYSTEM.ADR(b.tag));

   (* find last bitmap tag in list *)
   t := first; WHILE (t # NIL) DO t := t.next END;

   (* add new bitmap tag to list *)
   b.tag.next := first; first := SYSTEM.VAL(Tag, SYSTEM.ADR(b.tag));

   IF b.base = NIL THEN b := NIL
   ELSE (* report allocatted size and address *)
    Texts.WriteInt(W, b.tag.size, 6); Texts.WriteInt(W,
   SYSTEM.VAL(INTEGER,b.base), 8); Texts.WriteLn(W);
   Texts.Append(Oberon.Log, W.buf) END

  END 
 RETURN b END New;

 PROCEDURE Create*;
  VAR w, h:INTEGER; S: Texts.Scanner;
 BEGIN
  Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  IF S.class = Texts.Int THEN
    w := S.i; Texts.Scan(S);
    IF S.class = Texts.Int THEN h := S.i END
  END;

  B := New(w, h)
 END Create;

BEGIN Texts.OpenWriter(W); first := NIL
END BM.


Test allocating various block sizes
BM.Create 32 32 ~
BM.Create 256 256 ~
BM.Create 256 1024 ~
BM.Create 1024 1024 ~


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