home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #20 / NN_1992_20.iso / spool / comp / lang / modula2 / 1116 < prev    next >
Encoding:
Internet Message Format  |  1992-09-07  |  9.1 KB
  1. Path: sparky!uunet!mcsun!Germany.EU.net!unidui!flyer!easix!tron.gun.de!g_dotzel
  2. From: g_dotzel@tron.gun.de (Guenter Dotzel)
  3. Newsgroups: comp.lang.modula2
  4. Subject: Re: Oberon question/pointer initialisati
  5. Message-ID: <2953C1389G@tron.gun.de>
  6. Organization: TRON Public Mailbox, Neurath, Germany
  7. Date: Sat, 5 Sep 92 10:53:00 +0200
  8. Lines: 302
  9.  
  10. JPUSSI%CS.JOENSUU.FI@USENET.ZER wrote on Tue, 09-01-1992 at 08:20 h
  11. under the subject 'Oberon question':
  12.  
  13. > In some paper I read that in Oberon, all pointer variables are
  14. > initialised to NIL. Now I would like to know if this means that
  15. > also pointer fields in dynamically (with NEW) allocated records
  16. > or in static records are initialised to NIL. 
  17. > 
  18. > In short are pointers always either NIL or valid pointers and
  19. > not garbage pointers. May it vary between implementations?
  20.  
  21. In our implementation (Oberon-2 for VAX/VMS), *all pointers* are set to NIL
  22.  
  23. - All static (global) variables are set to 0 (0=NIL for pointers);
  24.   this is guaranteed by a linker directive for the VMS-program loader.
  25. - All local variables of any pointer type even within any record or
  26.   array structure are cleared to NIL when entering a procedure,
  27.   although we have an implementation restriction to max. 10000 pointers
  28.   per structure. The code to clear those variables is suppressed if you 
  29.   use the /NOCHECK compilation qualifier.
  30. - Heap space allocated with NEW is cleared to 0 at run-time.
  31.   It uses VMS's LIB$GET_VM and clears the memory allocated using the MOVC5
  32.   instruction (the run-time module could be replaced by a version that 
  33.   doesn't clear for time critical applications. (since a VMS routine is used
  34.   to allocate the heap, we can use ISO Modula-2's Storage.DEALLOCATE for
  35.   disposing it (see example below).
  36.  
  37. Below are two test programs
  38.  
  39. -testnew
  40. -TestLocalPtr
  41.  
  42. which we used to check our compiler implementation.
  43.  
  44. Greetings, Guenter
  45.  
  46. MODULE testnew;
  47. (* Oberon-2: check whether heap space is cleared to  0/NIL; ok if
  48.    the program doesn't call HALT when executed.
  49.  
  50. Guenter Dotzel, ModulaWare GmbH, Wilhelmstr. 17A, D-W 8520 Erlangen/F.R.Germany
  51. Modula-2 & Oberon-2 Compiler Manufactur (VAX/VMS, OS/2 and Unix-Platforms)
  52. Tel. +49 (9131) 208395, Fax +49 (9131) 28205.
  53. E-mail/Internet: 100023.2527@compuserve.com
  54.                  g_dotzel@ame.nbg.sub.org
  55. *)
  56. IMPORT SYSTEM, Storage, CTR, 
  57.   W:= SWholeIO, T:= STextIO; (* these are the ISO Modula-2 Std I/O Lib modules*)
  58.  
  59. CONST
  60.   PtrSize = SIZE(SYSTEM.WORD);
  61.   ExtOutput = FALSE;
  62.   s1 = 199000;
  63.   s2 = 10000;
  64.  
  65. TYPE x=ARRAY s1 OF CHAR;
  66.      y=ARRAY s2 OF CHAR;
  67.      z=RECORD a, b, c, d: LONGINT; END;
  68.  
  69.      rp = POINTER TO z;
  70.  
  71. VAR 
  72.   p: POINTER TO x; 
  73.   q: POINTER TO y;
  74.  
  75.   r: rp;
  76.   r1: POINTER TO RECORD a, b, c, d: LONGINT; END;
  77.   r2: POINTER TO z;
  78.  
  79.   i: LONGINT;
  80.   a: CTR.ADDRESS;
  81.   last: LONGINT;
  82.  
  83. BEGIN
  84.   NEW(p); last:= SYSTEM.VAL(LONGINT, p);
  85.   FOR i:= 0 TO s1 - 1 DO
  86.     p^[i]:= CHR(i MOD 256);
  87.   END;
  88.   a:= SYSTEM.VAL(CTR.ADDRESS, p);
  89.   Storage.DEALLOCATE(a, SIZE(x));
  90.   NEW(p);
  91.   IF last # SYSTEM.VAL(LONGINT, p) THEN
  92.     T.WriteString('"p" not reallocated at the same address'); T.WriteLn;
  93.     HALT(21);
  94.   END;
  95.   IF ExtOutput THEN
  96.     T.WriteString('test big array contents'); T.WriteLn; T.WriteLn;
  97.     T.WriteString('   index,    value'); T.WriteLn;
  98.   END;
  99.   FOR i:= 0 TO s1 - 1 DO
  100.     IF p^[i] # CHR(0) THEN 
  101.       IF ExtOutput THEN
  102.         W.WriteInt(i, 8);
  103.         W.WriteInt(ORD(p^[i]), 10); T.WriteLn;
  104.       ELSE
  105.         T.WriteString('big-array test failed at index '); W.WriteInt(i, 0);
  106.         T.WriteLn;
  107.         HALT(21);
  108.       END;
  109.     END;
  110.   END;
  111.  
  112.   NEW(q); last:= SYSTEM.VAL(LONGINT, q);
  113.   FOR i:= 0 TO s2 - 1 DO
  114.     q^[i]:= CHR(i MOD 256);
  115.   END;
  116.   a:= SYSTEM.VAL(CTR.ADDRESS, q);
  117.   Storage.DEALLOCATE(a, SIZE(y));
  118.   NEW(q);
  119.   IF last # SYSTEM.VAL(LONGINT, q) THEN
  120.     T.WriteString('"q" not reallocated at the same address'); T.WriteLn;
  121.     HALT(21);
  122.   END;
  123.   FOR i:= 0 TO s2 - 1 DO
  124.     IF q^[i] # CHR(0) THEN
  125.       T.WriteString('small-array test failed at index '); W.WriteInt(i, 0);
  126.       T.WriteLn;
  127.       HALT(31);
  128.     END;
  129.   END;
  130.  
  131.  
  132.   NEW(r);  r^.a:= -1;   r^.b:= -2;   r^.c:= -3;   r^.d:= -4;
  133.   last:= SYSTEM.VAL(LONGINT, r);
  134.   IF ExtOutput THEN
  135.     NEW(r1); r1^.a:= -1;  r1^.b:= -2;  r1^.c:= -3;  r1^.d:= -4;
  136.     NEW(r2); r2^.a:= -1;  r2^.b:= -2;  r2^.c:= -3;  r2^.d:= -4;
  137.  
  138.     T.WriteString('r        '); 
  139.     W.WriteInt(SYSTEM.VAL(LONGINT, r), 0); T.WriteLn;
  140.     T.WriteString('ADR(r^  )'); 
  141.     W.WriteInt(SYSTEM.VAL(LONGINT, SYSTEM.ADR(r^)), 0); T.WriteLn;
  142.     T.WriteString('ADR(r^.a)'); 
  143.     W.WriteInt(SYSTEM.VAL(LONGINT, SYSTEM.ADR(r^.a)), 0); T.WriteLn;
  144.     T.WriteString('ADR(r^.b)'); 
  145.     W.WriteInt(SYSTEM.VAL(LONGINT, SYSTEM.ADR(r^.b)), 0); T.WriteLn;
  146.     T.WriteString('ADR(r^.c)'); 
  147.     W.WriteInt(SYSTEM.VAL(LONGINT, SYSTEM.ADR(r^.c)), 0); T.WriteLn;
  148.     T.WriteString('ADR(r^.d)'); 
  149.     W.WriteInt(SYSTEM.VAL(LONGINT, SYSTEM.ADR(r^.d)), 0); T.WriteLn;
  150.   END;
  151.  
  152.   a:= SYSTEM.VAL(CTR.ADDRESS, SYSTEM.VAL(LONGINT, r) - PtrSize);
  153.   Storage.DEALLOCATE (a, SIZE(z) + PtrSize); (*adjust for type descriptor*)
  154.  
  155.   NEW(r);
  156.   IF last # SYSTEM.VAL(LONGINT, r) THEN
  157.     T.WriteString('"r" not reallocated at the same address'); T.WriteLn;
  158.     HALT(21);
  159.   END;
  160.   IF r^.a # 0 THEN 
  161.     T.WriteString('record test failed at field "a"'); T.WriteLn;
  162.     HALT(41); 
  163.   END;
  164.   IF r^.b # 0 THEN 
  165.     T.WriteString('record test failed at field "b"'); T.WriteLn;
  166.     HALT(41); 
  167.   END;
  168.   IF r^.c # 0 THEN 
  169.     T.WriteString('record test failed at field "c"'); T.WriteLn;
  170.     HALT(41); 
  171.   END;
  172.   IF r^.d # 0 THEN 
  173.     T.WriteString('record test failed at field "d"'); T.WriteLn;
  174.     HALT(41); 
  175.   END;
  176. END testnew.
  177. MODULE CTR;
  178. (* central definition of INTEGER and CARDINAL *)
  179. IMPORT SYSTEM;
  180.  
  181. TYPE 
  182.   INTEGER* = LONGINT; (* 32 Bit signed whole number type *)
  183.   CARDINAL* = LONGINT;
  184.   ADDRESS* = LONGINT; (* SYSTEM.ADR() is of LONGINT type! *)
  185.  
  186. (* select your enumeration types carefully: *)
  187.   ENUM8* = SHORTINT; (* ORD(MAX(corresponding_Modula_2_enum) < 256 *)
  188.   ENUM16* = INTEGER; (* ORD(MAX(corresponding_Modula_2_enum) < 65536 *)
  189.   ENUM32* = LONGINT; (* ORD(MAX(corresponding_Modula_2_enum) < 2^31 :-) *)
  190.  
  191. (* WORD and QUDWORD are extension of the Oberon-2 module SYSTEM:
  192.    Sorry, there was no other way! *)
  193.  
  194.   WORD* = SYSTEM.WORD; (* 32 Bit *)
  195.   (* WORD is used in ConvType only (no recursive procedure definitions) *)
  196.  
  197.   QUADWORD* = SYSTEM.QUADWORD; (* 64 Bit *)
  198.   (* QUADWORD is used in RndFile only (no structured function values) *)
  199.  
  200. END CTR.
  201.  
  202. MODULE TestLocalPtr;
  203. (* Oberon-2: tests whether all ptrs are cleared to nil at startup 
  204.   and procedure entry.
  205.  
  206. Guenter Dotzel, ModulaWare GmbH, Wilhelmstr. 17A, D-W 8520 Erlangen/F.R.Germany
  207. Modula-2 & Oberon-2 Compiler Manufactur (VAX/VMS, OS/2 and Unix-Platforms)
  208. Tel. +49 (9131) 208395, Fax +49 (9131) 28205.
  209. E-mail/Internet: 100023.2527@compuserve.com
  210.                  g_dotzel@ame.nbg.sub.org
  211.  
  212. EB/04-Sep-1992
  213. *)
  214.  
  215.  
  216. TYPE
  217.   ptr = POINTER TO structure;
  218.  
  219.   structure = RECORD
  220.     p1, p2, p3: ptr;
  221.   END;
  222.  
  223. VAR
  224.   s: structure;
  225.   garbage: ARRAY 20000 OF CHAR;
  226.   i: LONGINT;
  227.  
  228. PROCEDURE x;
  229.  
  230. TYPE
  231.   extension = RECORD
  232.     (structure)
  233.     p4, p5, p6: ptr;
  234.     k: LONGINT;
  235.     c: CHAR;
  236.   END;
  237.   ptrarray = ARRAY 200 OF ptr;
  238.  
  239. VAR
  240.     test1: INTEGER;
  241.   s: structure;
  242.     test5: INTEGER;
  243.   e: extension;
  244.     test2: INTEGER;
  245.   l1, l2, l3: ptr;
  246.     test6: INTEGER;
  247.   q: ptrarray;
  248.     test3: INTEGER;
  249.   r: RECORD
  250.     p1, p2, p3, p4, p5,
  251.     p6, p7, p8, p9, p0 : ptr;
  252.   END;
  253.     test4: INTEGER;
  254.   pa: POINTER TO ARRAY 10 OF CHAR;
  255.   i: INTEGER;
  256.  
  257. BEGIN
  258.   IF test1 = 0 THEN     HALT(99); END;  (* stack must be non zero *)
  259.   IF test2 = 0 THEN     HALT(99); END;  (* stack must be non zero *)
  260.   IF test3 = 0 THEN     HALT(99); END;  (* stack must be non zero *)
  261.   IF test4 = 0 THEN     HALT(99); END;  (* stack must be non zero *)
  262.   IF test5 = 0 THEN     HALT(99); END;  (* stack must be non zero *)
  263.   IF test6 = 0 THEN     HALT(99); END;  (* stack must be non zero *)
  264.  
  265.   IF s.p1   # NIL THEN HALT(31); END;
  266.   IF s.p2   # NIL THEN HALT(32); END;
  267.   IF s.p3   # NIL THEN HALT(33); END;
  268.   IF e.p1   # NIL THEN HALT(41); END;
  269.   IF e.p2   # NIL THEN HALT(42); END;
  270.   IF e.p3   # NIL THEN HALT(43); END;
  271.   IF e.p4   # NIL THEN HALT(44); END;
  272.   IF e.p5   # NIL THEN HALT(45); END;
  273.   IF e.p6   # NIL THEN HALT(46); END;
  274.   IF l1     # NIL THEN HALT(51); END;
  275.   IF l2     # NIL THEN HALT(51); END;
  276.   IF l3     # NIL THEN HALT(51); END;
  277.  
  278.   FOR i:= 0 TO 199 DO 
  279.     IF q[i] # NIL THEN HALT(61); END; 
  280.   END;
  281.  
  282.   IF r.p1   # NIL THEN HALT(71); END;
  283.   IF r.p2   # NIL THEN HALT(72); END;
  284.   IF r.p3   # NIL THEN HALT(73); END;
  285.   IF r.p4   # NIL THEN HALT(74); END;
  286.   IF r.p5   # NIL THEN HALT(75); END;
  287.   IF r.p6   # NIL THEN HALT(76); END;
  288.   IF r.p7   # NIL THEN HALT(77); END;
  289.   IF r.p8   # NIL THEN HALT(78); END;
  290.   IF r.p9   # NIL THEN HALT(79); END;
  291.   IF r.p0   # NIL THEN HALT(80); END;
  292.  
  293.   IF pa     # NIL THEN HALT(91); END;
  294. END x;
  295.  
  296. PROCEDURE g(a: ARRAY OF CHAR; VAR b: ARRAY OF CHAR);
  297. BEGIN a[0]:= 'A'; b[0]:= 'B'; INC(i);
  298.   IF i < 10 THEN g(b, a); x; (* recurse 10 times on stack *)
  299.   END;
  300. END g;
  301.  
  302. BEGIN
  303.   FOR i:= 0 TO 19999 DO garbage[i]:= CHR(i MOD 254 + 1); END; (* non zero *)
  304.   IF s.p1 # NIL THEN HALT(21); END;
  305.   IF s.p2 # NIL THEN HALT(22); END;
  306.   IF s.p3 # NIL THEN HALT(23); END;
  307.   i:= 0;
  308.   g(garbage, garbage); (* create garbage on stack *)
  309.   x;
  310. END TestLocalPtr.
  311.  
  312.