🚀 go-pugleaf

JPUSSI%CS.JOENSUU.FI@USENET.ZER wrote on Tue, 09-01-1992 at 08:20 h
under the subject 'Oberon question':

> In some paper I read that in Oberon, all pointer variables are
> initialised to NIL. Now I would like to know if this means that
> also pointer fields in dynamically (with NEW) allocated records
> or in static records are initialised to NIL. 
> 
> In short are pointers always either NIL or valid pointers and
> not garbage pointers. May it vary between implementations?

In our implementation (Oberon-2 for VAX/VMS), *all pointers* are set to NIL

- All static (global) variables are set to 0 (0=NIL for pointers);
  this is guaranteed by a linker directive for the VMS-program loader.
- All local variables of any pointer type even within any record or
  array structure are cleared to NIL when entering a procedure,
  although we have an implementation restriction to max. 10000 pointers
  per structure. The code to clear those variables is suppressed if you 
  use the /NOCHECK compilation qualifier.
- Heap space allocated with NEW is cleared to 0 at run-time.
  It uses VMS's LIB$GET_VM and clears the memory allocated using the MOVC5
  instruction (the run-time module could be replaced by a version that 
  doesn't clear for time critical applications. (since a VMS routine is used
  to allocate the heap, we can use ISO Modula-2's Storage.DEALLOCATE for
  disposing it (see example below).

Below are two test programs

-testnew
-TestLocalPtr

which we used to check our compiler implementation.

Greetings, Guenter

MODULE testnew;
(* Oberon-2: check whether heap space is cleared to  0/NIL; ok if
   the program doesn't call HALT when executed.

Guenter Dotzel, ModulaWare GmbH, Wilhelmstr. 17A, D-W 8520 Erlangen/F.R.Germany
Modula-2 & Oberon-2 Compiler Manufactur (VAX/VMS, OS/2 and Unix-Platforms)
Tel. +49 (9131) 208395, Fax +49 (9131) 28205.
E-mail/Internet: 100023.2527@compuserve.com
                 g_dotzel@ame.nbg.sub.org
*)
IMPORT SYSTEM, Storage, CTR, 
  W:= SWholeIO, T:= STextIO; (* these are the ISO Modula-2 Std I/O Lib modules*)

CONST
  PtrSize = SIZE(SYSTEM.WORD);
  ExtOutput = FALSE;
  s1 = 199000;
  s2 = 10000;

TYPE x=ARRAY s1 OF CHAR;
     y=ARRAY s2 OF CHAR;
     z=RECORD a, b, c, d: LONGINT; END;

     rp = POINTER TO z;

VAR 
  p: POINTER TO x; 
  q: POINTER TO y;

  r: rp;
  r1: POINTER TO RECORD a, b, c, d: LONGINT; END;
  r2: POINTER TO z;

  i: LONGINT;
  a: CTR.ADDRESS;
  last: LONGINT;

BEGIN
  NEW(p); last:= SYSTEM.VAL(LONGINT, p);
  FOR i:= 0 TO s1 - 1 DO
    p^[i]:= CHR(i MOD 256);
  END;
  a:= SYSTEM.VAL(CTR.ADDRESS, p);
  Storage.DEALLOCATE(a, SIZE(x));
  NEW(p);
  IF last # SYSTEM.VAL(LONGINT, p) THEN
    T.WriteString('"p" not reallocated at the same address'); T.WriteLn;
    HALT(21);
  END;
  IF ExtOutput THEN
    T.WriteString('test big array contents'); T.WriteLn; T.WriteLn;
    T.WriteString('   index,    value'); T.WriteLn;
  END;
  FOR i:= 0 TO s1 - 1 DO
    IF p^[i] # CHR(0) THEN 
      IF ExtOutput THEN
        W.WriteInt(i, 8);
        W.WriteInt(ORD(p^[i]), 10); T.WriteLn;
      ELSE
        T.WriteString('big-array test failed at index '); W.WriteInt(i, 0);
        T.WriteLn;
        HALT(21);
      END;
    END;
  END;

  NEW(q); last:= SYSTEM.VAL(LONGINT, q);
  FOR i:= 0 TO s2 - 1 DO
    q^[i]:= CHR(i MOD 256);
  END;
  a:= SYSTEM.VAL(CTR.ADDRESS, q);
  Storage.DEALLOCATE(a, SIZE(y));
  NEW(q);
  IF last # SYSTEM.VAL(LONGINT, q) THEN
    T.WriteString('"q" not reallocated at the same address'); T.WriteLn;
    HALT(21);
  END;
  FOR i:= 0 TO s2 - 1 DO
    IF q^[i] # CHR(0) THEN
      T.WriteString('small-array test failed at index '); W.WriteInt(i, 0);
      T.WriteLn;
      HALT(31);
    END;
  END;


  NEW(r);  r^.a:= -1;   r^.b:= -2;   r^.c:= -3;   r^.d:= -4;
  last:= SYSTEM.VAL(LONGINT, r);
  IF ExtOutput THEN
    NEW(r1); r1^.a:= -1;  r1^.b:= -2;  r1^.c:= -3;  r1^.d:= -4;
    NEW(r2); r2^.a:= -1;  r2^.b:= -2;  r2^.c:= -3;  r2^.d:= -4;

    T.WriteString('r        '); 
    W.WriteInt(SYSTEM.VAL(LONGINT, r), 0); T.WriteLn;
    T.WriteString('ADR(r^  )'); 
    W.WriteInt(SYSTEM.VAL(LONGINT, SYSTEM.ADR(r^)), 0); T.WriteLn;
    T.WriteString('ADR(r^.a)'); 
    W.WriteInt(SYSTEM.VAL(LONGINT, SYSTEM.ADR(r^.a)), 0); T.WriteLn;
    T.WriteString('ADR(r^.b)'); 
    W.WriteInt(SYSTEM.VAL(LONGINT, SYSTEM.ADR(r^.b)), 0); T.WriteLn;
    T.WriteString('ADR(r^.c)'); 
    W.WriteInt(SYSTEM.VAL(LONGINT, SYSTEM.ADR(r^.c)), 0); T.WriteLn;
    T.WriteString('ADR(r^.d)'); 
    W.WriteInt(SYSTEM.VAL(LONGINT, SYSTEM.ADR(r^.d)), 0); T.WriteLn;
  END;

  a:= SYSTEM.VAL(CTR.ADDRESS, SYSTEM.VAL(LONGINT, r) - PtrSize);
  Storage.DEALLOCATE (a, SIZE(z) + PtrSize); (*adjust for type descriptor*)

  NEW(r);
  IF last # SYSTEM.VAL(LONGINT, r) THEN
    T.WriteString('"r" not reallocated at the same address'); T.WriteLn;
    HALT(21);
  END;
  IF r^.a # 0 THEN 
    T.WriteString('record test failed at field "a"'); T.WriteLn;
    HALT(41); 
  END;
  IF r^.b # 0 THEN 
    T.WriteString('record test failed at field "b"'); T.WriteLn;
    HALT(41); 
  END;
  IF r^.c # 0 THEN 
    T.WriteString('record test failed at field "c"'); T.WriteLn;
    HALT(41); 
  END;
  IF r^.d # 0 THEN 
    T.WriteString('record test failed at field "d"'); T.WriteLn;
    HALT(41); 
  END;
END testnew.
MODULE CTR;
(* central definition of INTEGER and CARDINAL *)
IMPORT SYSTEM;

TYPE 
  INTEGER* = LONGINT; (* 32 Bit signed whole number type *)
  CARDINAL* = LONGINT;
  ADDRESS* = LONGINT; (* SYSTEM.ADR() is of LONGINT type! *)

(* select your enumeration types carefully: *)
  ENUM8* = SHORTINT; (* ORD(MAX(corresponding_Modula_2_enum) < 256 *)
  ENUM16* = INTEGER; (* ORD(MAX(corresponding_Modula_2_enum) < 65536 *)
  ENUM32* = LONGINT; (* ORD(MAX(corresponding_Modula_2_enum) < 2^31 :-) *)

(* WORD and QUDWORD are extension of the Oberon-2 module SYSTEM:
   Sorry, there was no other way! *)

  WORD* = SYSTEM.WORD; (* 32 Bit *)
  (* WORD is used in ConvType only (no recursive procedure definitions) *)

  QUADWORD* = SYSTEM.QUADWORD; (* 64 Bit *)
  (* QUADWORD is used in RndFile only (no structured function values) *)

END CTR.

MODULE TestLocalPtr;
(* Oberon-2: tests whether all ptrs are cleared to nil at startup 
  and procedure entry.

Guenter Dotzel, ModulaWare GmbH, Wilhelmstr. 17A, D-W 8520 Erlangen/F.R.Germany
Modula-2 & Oberon-2 Compiler Manufactur (VAX/VMS, OS/2 and Unix-Platforms)
Tel. +49 (9131) 208395, Fax +49 (9131) 28205.
E-mail/Internet: 100023.2527@compuserve.com
                 g_dotzel@ame.nbg.sub.org

EB/04-Sep-1992
*)


TYPE
  ptr = POINTER TO structure;

  structure = RECORD
    p1, p2, p3: ptr;
  END;

VAR
  s: structure;
  garbage: ARRAY 20000 OF CHAR;
  i: LONGINT;

PROCEDURE x;

TYPE
  extension = RECORD
    (structure)
    p4, p5, p6: ptr;
    k: LONGINT;
    c: CHAR;
  END;
  ptrarray = ARRAY 200 OF ptr;

VAR
    test1: INTEGER;
  s: structure;
    test5: INTEGER;
  e: extension;
    test2: INTEGER;
  l1, l2, l3: ptr;
    test6: INTEGER;
  q: ptrarray;
    test3: INTEGER;
  r: RECORD
    p1, p2, p3, p4, p5,
    p6, p7, p8, p9, p0 : ptr;
  END;
    test4: INTEGER;
  pa: POINTER TO ARRAY 10 OF CHAR;
  i: INTEGER;

BEGIN
  IF test1 = 0 THEN     HALT(99); END;  (* stack must be non zero *)
  IF test2 = 0 THEN     HALT(99); END;  (* stack must be non zero *)
  IF test3 = 0 THEN     HALT(99); END;  (* stack must be non zero *)
  IF test4 = 0 THEN     HALT(99); END;  (* stack must be non zero *)
  IF test5 = 0 THEN     HALT(99); END;  (* stack must be non zero *)
  IF test6 = 0 THEN     HALT(99); END;  (* stack must be non zero *)

  IF s.p1   # NIL THEN HALT(31); END;
  IF s.p2   # NIL THEN HALT(32); END;
  IF s.p3   # NIL THEN HALT(33); END;
  IF e.p1   # NIL THEN HALT(41); END;
  IF e.p2   # NIL THEN HALT(42); END;
  IF e.p3   # NIL THEN HALT(43); END;
  IF e.p4   # NIL THEN HALT(44); END;
  IF e.p5   # NIL THEN HALT(45); END;
  IF e.p6   # NIL THEN HALT(46); END;
  IF l1     # NIL THEN HALT(51); END;
  IF l2     # NIL THEN HALT(51); END;
  IF l3     # NIL THEN HALT(51); END;

  FOR i:= 0 TO 199 DO 
    IF q[i] # NIL THEN HALT(61); END; 
  END;

  IF r.p1   # NIL THEN HALT(71); END;
  IF r.p2   # NIL THEN HALT(72); END;
  IF r.p3   # NIL THEN HALT(73); END;
  IF r.p4   # NIL THEN HALT(74); END;
  IF r.p5   # NIL THEN HALT(75); END;
  IF r.p6   # NIL THEN HALT(76); END;
  IF r.p7   # NIL THEN HALT(77); END;
  IF r.p8   # NIL THEN HALT(78); END;
  IF r.p9   # NIL THEN HALT(79); END;
  IF r.p0   # NIL THEN HALT(80); END;

  IF pa     # NIL THEN HALT(91); END;
END x;

PROCEDURE g(a: ARRAY OF CHAR; VAR b: ARRAY OF CHAR);
BEGIN a[0]:= 'A'; b[0]:= 'B'; INC(i);
  IF i < 10 THEN g(b, a); x; (* recurse 10 times on stack *)
  END;
END g;

BEGIN
  FOR i:= 0 TO 19999 DO garbage[i]:= CHR(i MOD 254 + 1); END; (* non zero *)
  IF s.p1 # NIL THEN HALT(21); END;
  IF s.p2 # NIL THEN HALT(22); END;
  IF s.p3 # NIL THEN HALT(23); END;
  i:= 0;
  g(garbage, garbage); (* create garbage on stack *)
  x;
END TestLocalPtr.