[Oberon] PO: Illegal memory access in GC

[Andreas Pirklbauer]

    > The reason for the illegal memory read lies within the
    > garbage collector in module Kernel.Mod.


PS: Below is one possible fix for PO 2013 and Extended Oberon.
Only procedure Kernel.Mark needs to be modified in two places
-ap



PO 2013:
~~~~~~~

  PROCEDURE Mark*(pref: LONGINT);
    VAR pvadr, offadr, offset, tag, p, q, r: LONGINT;
  BEGIN SYSTEM.GET(pref, pvadr); (*pointers < heapOrg considered NIL*)
    WHILE pvadr # 0 DO SYSTEM.GET(pvadr, p);
      IF p >= heapOrg THEN SYSTEM.GET(p-4, offadr);
        IF offadr = 0 THEN q := p;   (*mark elements in data structure with root p*)
          REPEAT SYSTEM.GET(p-4, offadr);
            IF offadr = 0 THEN SYSTEM.GET(p-8, tag); offadr := tag + 16 ELSE INC(offadr, 4) END ;
            SYSTEM.PUT(p-4, offadr); SYSTEM.GET(offadr, offset);
            IF offset # -1 THEN (*down*)
              SYSTEM.GET(p+offset, r);
              IF r >= heapOrg THEN SYSTEM.GET(r-4, offadr);
                IF offadr = 0 THEN SYSTEM.PUT(p+offset, q); q := p; p := r END
              END
            ELSE (*up*) SYSTEM.GET(q-4, offadr); SYSTEM.GET(offadr, offset);
              IF p # q THEN SYSTEM.GET(q+offset, r); SYSTEM.PUT(q+offset, p); p := q; q := r END
            END
          UNTIL (p = q) & (offset = -1)
        END
      END ;
      INC(pref, 4); SYSTEM.GET(pref, pvadr)
    END
  END Mark;


EO:
~~~


  PROCEDURE Mark*(pref: LONGINT);
    VAR pvadr, offadr, offset, tag, p, q, r, pos, len, elemsize, blktyp: LONGINT;
  BEGIN SYSTEM.GET(pref, pvadr); (*pointers < heapOrg considered NIL*)
    WHILE pvadr # 0 DO SYSTEM.GET(pvadr, p);
      IF p >= heapOrg THEN SYSTEM.GET(p-4, offadr);
        IF offadr = 0 THEN q := p;  (*mark elements in data structure with root p*)
          REPEAT SYSTEM.GET(p-4, offadr); SYSTEM.GET(p-8, tag); blktyp := tag MOD 4;
            IF blktyp = 0 THEN (*record*) pos := p;
              IF offadr = 0 THEN offadr := tag + 16 ELSE INC(offadr, 4) END ;
              SYSTEM.PUT(p-4, offadr); SYSTEM.GET(offadr, offset)
            ELSIF blktyp = 1 THEN (*array of record*)
              IF offadr = 0 THEN offadr := tag + 15; pos := p + 16; SYSTEM.PUT(p+12, pos) ELSE INC(offadr); SYSTEM.GET(p+12, pos) END ;
              SYSTEM.GET(offadr, offset);
              IF offset = -1 THEN SYSTEM.GET(p, len); SYSTEM.GET(p+4, elemsize); INC(pos, elemsize);
                IF pos < p + 16 + len*elemsize THEN offadr := tag + 15; SYSTEM.GET(offadr, offset); SYSTEM.PUT(p+12, pos) END
              END ;
              SYSTEM.PUT(p-4, offadr)
            ELSIF blktyp = 2 THEN (*array of pointer*) pos := p + 16;
              IF offadr = 0 THEN offset := 0; SYSTEM.PUT(p-4, p+12) (*offadr*)
              ELSE SYSTEM.GET(p, len); SYSTEM.GET(p+12, offset); INC(offset, 4);
                IF offset >= len*4 THEN offset := -1 END
              END ;
              SYSTEM.PUT(p+12, offset)
            ELSE (*array of basic type (tag = 3) or array of procedure (tag = 7)*)
              offset := -1; SYSTEM.PUT(p+12, -1); SYSTEM.PUT(p-4, p+12) (*offadr*)
            END ;
            IF offset # -1 THEN (*down*)
              SYSTEM.GET(pos+offset, r);
              IF r >= heapOrg THEN SYSTEM.GET(r-4, offadr);
                IF offadr = 0 THEN SYSTEM.PUT(pos+offset, q); q := p; p := r END
              END
            ELSE (*up*) SYSTEM.GET(q-4, offadr); SYSTEM.GET(offadr, offset);
              IF p # q THEN SYSTEM.GET(q-8, tag); blktyp := tag MOD 4;
                IF blktyp = 0 THEN pos := q ELSIF blktyp = 1 THEN SYSTEM.GET(q+12, pos) ELSE pos := q + 16 END ;
                SYSTEM.GET(pos+offset, r); SYSTEM.PUT(pos+offset, p); p := q; q := r
              END
            END
          UNTIL (p = q) & (offset = -1)
        END
      END ;
      INC(pref, 4); SYSTEM.GET(pref, pvadr)
    END
  END Mark;