The ModulaTor logo 7KB

The ModulaTor

Oberon-2 and Modula-2 Technical Publication

Erlangen's First Independent Modula_2 Journal! Nr. 2/Mar-1993


How to create and access Oberon-2's Dynamic Arrays in Modula-2?

by Günter Dotzel, ModulaWare

Believe it or not, after seven years, ISO Modula-2 finally gets into DIS stage with the 2nd CD. But there are still Modula-2 compilers being developed with non-standard language extensions. From the aspect of source code portablity, some language extensions are more or less harmless. One example is the use of non-standard pervasive functions. If you used a built-in function


PROCEDURE LEN(s: ARRAY OF CHAR): CARDINAL 
which is called LENGTH is ISO Modula-2, the calls to LEN are easily replaced by calls to LENGTH.

But if you used non-standard syntactic and semantic language extensions you are out-of-luck in most cases. Consider for example Oberon-2's dynamic arrays - though a powerful feature, are not contained in ISO Modula-2. Dynamic arrays have open dimensions like open array procedure parameter in ISO Modula-2. But in contrast, dynamic arrays are created at run-time whereas an open array parameter in Modula-2 always comes from a statically declared array type with fixed index ranges.

In 1992, a commercial Modula-2 compiler with language support for dynamic arrays was announced. This compiler was developed by compiler writers who are aware of ISO Modula-2 and who are even members of the ISO Modula-2 Standardisation Committee.

Recent experience told me that this compiler and its non-standard language extensions is even used in industry.

It's sad but true!

The programmers of a large company bought that compiler and used dynamic arrays extensively in a large project programmed in Modula-2. They didn't even notice that they were using a non-standard language feature which was not available by any other commercially supported Modula-2 compiler.

After some months, some 20,000 source lines were written and the design team planned to port the software to another platform. They scanned through the data sheets of Modula-2 compiler products available for the new platform and recognised that all other compilers are no good, because they don't have dynamic arrays. They even could not switch to Oberon-2 because they heavily used enumerations in their programs.

In March, 1993, they called and asked whether ModulaWare would like to extend the VAX/VMS Modula-2 compiler MVR with dynamic arrays and asked how long it would take and how much it would cost.

ModulaWare is committed to ISO Modula-2 but we also developed an Oberon-2 compiler and know how to do dynamic arrays and it would be quite easy to extend the Modula-2 compiler. But experience told me that non-standard language extension do not pay off and would be counterproductive to the spread of Modula-2. Compiler writers must be able to resist such situation.

After a couple of days thinking about this conflicting situation, I got an idea how to support dynamic arrays in ISO Modula-2 without any language extension. The first try was to have an Oberon-2 main program where dynamic arrays could be created and then passed to modules written in Modula-2 via a procedure called with a multi-dimensional open array parameter.

Contents, Module Set 1



MODULE testdynm2; PROCEDURE P1 *(VAR a: ARRAY OF INTEGER); END P1; PROCEDURE P2 *(VAR a: ARRAY OF ARRAY OF INTEGER); END P2; PROCEDURE P3 *(VAR a: ARRAY OF ARRAY OF ARRAY OF INTEGER); END P3; PROCEDURE P4 *(VAR a: ARRAY OF ARRAY OF ARRAY OF ARRAY OF INTEGER); END P4; END testdynm2.
MODULE Testdyno2; (* written in Oberon-2 25-Mar-1993 by Petra Fabian *) IMPORT T := Testdynm2, S := SWholeIO, O := STextIO; TYPE t1 = ARRAY OF INTEGER; t2 = ARRAY OF t1; t3 = ARRAY OF t2; t4 = ARRAY OF t3; VAR v : POINTER TO t1; w : POINTER TO t2; x : POINTER TO t3; y : POINTER TO t4; PROCEDURE L1(a: t1); VAR j : INTEGER; BEGIN FOR j := 0 TO LEN(a,0) - 1 DO S.WriteInt(a[j],6); END; O.WriteLn; END L1; PROCEDURE L2(a: t2); VAR k : INTEGER; BEGIN FOR k := 0 TO LEN(a,0) - 1 DO L1(a[k]); END; O.WriteLn; END L2; PROCEDURE L3(a: t3); VAR l : INTEGER; BEGIN FOR l := 0 TO LEN(a,0) - 1 DO L2(a[l]); END; O.WriteLn; END L3; PROCEDURE L4(a: t4); VAR m : INTEGER; BEGIN FOR m := 0 TO LEN(a,0) - 1 DO L3(a[m]); END; O.WriteLn; END L4; BEGIN (* create *) NEW(v,5); NEW(w,5,4); NEW(x,5,4,3); NEW(y,5,4,3,2); (* process *) T.P1(v^); T.P2(w^); T.P3(x^); T.P4(y^); (* display *) L1(v^); L2(w^); L3(x^); L4(y^); END Testdyno2.
DEFINITION MODULE Testdynm2; PROCEDURE P1(VAR a: ARRAY OF INTEGER); PROCEDURE P2(VAR a: ARRAY OF ARRAY OF INTEGER); PROCEDURE P3(VAR a: ARRAY OF ARRAY OF ARRAY OF INTEGER); PROCEDURE P4(VAR a: ARRAY OF ARRAY OF ARRAY OF ARRAY OF INTEGER); END Testdynm2.
IMPLEMENTATION MODULE Testdynm2; (* written in Modula-2, 25-Mar-1993 by Petra Fabian *) VAR p : INTEGER; PROCEDURE P1(VAR a: ARRAY OF INTEGER); VAR j : CARDINAL; BEGIN FOR j := 0 TO HIGH(a) DO a[j] := p; INC(p); END; END P1; PROCEDURE P2(VAR a: ARRAY OF ARRAY OF INTEGER); VAR k : CARDINAL; BEGIN FOR k := 0 TO HIGH(a) DO P1(a[k]); END; END P2; PROCEDURE P3(VAR a: ARRAY OF ARRAY OF ARRAY OF INTEGER); VAR l : CARDINAL; BEGIN FOR l := 0 TO HIGH(a) DO P2(a[l]); END; END P3; PROCEDURE P4(VAR a: ARRAY OF ARRAY OF ARRAY OF ARRAY OF INTEGER); VAR l : CARDINAL; BEGIN FOR l := 0 TO HIGH(a) DO P3(a[l]); END; END P4; BEGIN p := 0; END Testdynm2.

This solution has several drawbacks, because the dynamic arrays and their descriptors could not be declared and created from within a Modula-2 program. So I developed another auxiliary module called DynArr. DynArr Contents, Module Set 2


DEFINITION MODULE DynArr; (* written in Modula-2 by Guenter Dotzel, 27-Mar-1993 Email: [email deleted due to spam] http://www.modulaware.com Modula-2 interface module for DynArr.Mod written in Oberon-2 *) TYPE A1; TYPE A2; TYPE A3; TYPE A4; T1 = INTEGER; T2 = T1; T3 = T2; T4 = T3; P1 = PROCEDURE (VAR ARRAY OF T1); P2 = PROCEDURE (VAR ARRAY OF ARRAY OF T2); P3 = PROCEDURE (VAR ARRAY OF ARRAY OF ARRAY OF T3); P4 = PROCEDURE (VAR ARRAY OF ARRAY OF ARRAY OF ARRAY OF T4); PROCEDURE New1(VAR a: A1; dim0: INTEGER); PROCEDURE New2(VAR a: A2; dim0, dim1: INTEGER); PROCEDURE New3(VAR a: A3; dim0, dim1, dim2: INTEGER); PROCEDURE New4(VAR a: A4; dim0, dim1, dim2, dim3: INTEGER); PROCEDURE Call1(a: A1; P: P1); PROCEDURE Call2(a: A2; P: P2); PROCEDURE Call3(a: A3; P: P3); PROCEDURE Call4(a: A4; P: P4); END DynArr.
MODULE TestDynArr; (* written in Modula-2, 27-Mar-1993 by Guenter Dotzel, Email: [email deleted due to spam] http://www.modulaware.com
TestDynArr The implementation of imported module DynArr is written in Oberon-2, which serves to automatically convert dynamic array- to open array-descriptors when calling a procedure supplied as parameter which itself has a formal parameter of open array type.

If your Modula-2 compiler supports multi-dimensional open arrays, then you can take advantage of dynamic arrays too. (This programs compiles with ModulaWare's VAX/VMS Modula-2 Compiler V4.00 and up.) If no Oberon-2 compiler is available to compile DynArr or if Oberon-2's parameter passing mechanisms aren't compatible, with Modula-2's open arrays, DynArr.Mod could well be implemented using a low-level language such as assembly or C. In this case, the caller takes care of the conversion from DynArr's internal dynamic array descriptor to the open array dimensions' high-value. With the introduction of additional Dispose procedures in DynArr, dynamic arrays could also be disposed. See module DynArrM2.Def which shows a template interface. DynArrM2 also defines the data structure for Oberon-2's dynamic arrays as implemented in ModulaWare's VAX/VMS Oberon-2 Compiler (H2O).


*)
IMPORT DynArr, SWholeIO, STextIO;

VAR c1,c2,c3,c4, p: INTEGER;
  a1, b1: DynArr.A1;
  a2, b2: DynArr.A2;
  a3, b3: DynArr.A3;
  a4, b4: DynArr.A4;

PROCEDURE L1(VAR a: ARRAY OF DynArr.T1);
VAR j : INTEGER;
BEGIN
  FOR j := 0 TO HIGH(a) DO SWholeIO.WriteInt(a[j],6); END; STextIO.WriteLn;
END L1;

PROCEDURE L2(VAR a: ARRAY OF ARRAY OF DynArr.T2);
VAR k : INTEGER;
BEGIN
  FOR k := 0 TO HIGH(a) DO L1(a[k]); END; STextIO.WriteLn;
END L2;

PROCEDURE L3(VAR a: ARRAY OF ARRAY OF ARRAY OF DynArr.T3);
VAR l : INTEGER;
BEGIN
  FOR l := 0 TO HIGH(a) DO L2(a[l]); END; STextIO.WriteLn;
END L3;

PROCEDURE L4(VAR a: ARRAY OF ARRAY OF ARRAY OF ARRAY OF DynArr
.T4);
VAR m : INTEGER;
BEGIN
  FOR m := 0 TO HIGH(a) DO L3(a[m]); END; STextIO.WriteLn;
END L4;

PROCEDURE P1(VAR a: ARRAY OF DynArr.T1);
VAR i0: INTEGER;
BEGIN
  FOR i0:=0 TO HIGH(a) DO a[i0]:=p; INC(p); END;
END P1;

PROCEDURE P2(VAR a: ARRAY OF ARRAY OF DynArr.T2);
VAR i0: INTEGER;
BEGIN
  FOR i0:=0 TO HIGH(a) DO P1(a[i0]); END;
END P2;

PROCEDURE P3(VAR a: ARRAY OF ARRAY OF ARRAY OF DynArr.T2);
VAR i0: INTEGER;
BEGIN
  FOR i0:=0 TO HIGH(a) DO P2(a[i0]); END;
END P3;

PROCEDURE P4(VAR a: ARRAY OF ARRAY OF ARRAY OF ARRAY OF DynArr
.T2);
VAR i0: INTEGER;
BEGIN
  FOR i0:=0 TO HIGH(a) DO P3(a[i0]); END;
END P4;

BEGIN
  p:=0;
  (* create *)
  DynArr.New1(a1, 5);
  DynArr.New2(a2, 5,4);
  DynArr.New3(a3, 5,4,3);
  DynArr.New4(a4, 5,4,3,2);

  DynArr.New1(b1, 6);
  DynArr.New2(b2, 6,5);
  DynArr.New3(b3, 6,5,4);
  DynArr.New4(b4, 6,5,4,3);

  (* process *)
  DynArr.Call1(a1,P1);
  DynArr.Call1(b1,P1);
  DynArr.Call2(a2,P2);
  DynArr.Call2(b2,P2);
  DynArr.Call3(a3,P3);
  DynArr.Call3(b3,P3);
  DynArr.Call4(a4,P4);
  DynArr.Call4(b4,P4);

  (* display *)
  DynArr.Call1(a1,L1);
  DynArr.Call2(a2,L2);
  DynArr.Call3(a3,L3);
  DynArr.Call4(a4,L4);
  DynArr.Call1(b1,L1);
  DynArr.Call2(b2,L2);
  DynArr.Call3(b3,L3);
  DynArr.Call4(b4,L4);
END TestDynArr.

MODULE DynArr; (* written in Oberon-2 by Guenter Dotzel, 27-Mar-1993 Email: [email deleted due to spam] http://www.modulaware.com *) TYPE INTEGER* = LONGINT; T1* = INTEGER; T2* = T1; T3* = T2; T4* = T3; A1* = POINTER TO ARRAY OF T1; A2* = POINTER TO ARRAY OF ARRAY OF T2; A3* = POINTER TO ARRAY OF ARRAY OF ARRAY OF T3; A4* = POINTER TO ARRAY OF ARRAY OF ARRAY OF ARRAY OF T4; P1* = PROCEDURE (VAR a: ARRAY OF T1); P2* = PROCEDURE (VAR a: ARRAY OF ARRAY OF T2); P3* = PROCEDURE (VAR a: ARRAY OF ARRAY OF ARRAY OF T3); P4* = PROCEDURE (VAR a: ARRAY OF ARRAY OF ARRAY OF ARRAY OF T4); PROCEDURE New1*(VAR a: A1; dim0: INTEGER); BEGIN NEW(a, dim0); END New1; PROCEDURE New2*(VAR a: A2; dim0, dim1: INTEGER); BEGIN NEW(a, dim0, dim1); END New2; PROCEDURE New3*(VAR a: A3; dim0, dim1, dim2: INTEGER); BEGIN NEW(a, dim0, dim1, dim2); END New3; PROCEDURE New4*(VAR a: A4; dim0, dim1, dim2, dim3: INTEGER); BEGIN NEW(a, dim0, dim1, dim2, dim3); END New4; PROCEDURE Call1*(a: A1; P: P1); BEGIN P(a^); END Call1; PROCEDURE Call2*(a: A2; P: P2); BEGIN P(a^); END Call2; PROCEDURE Call3*(a: A3; P: P3); BEGIN P(a^); END Call3; PROCEDURE Call4*(a: A4; P: P4); BEGIN P(a^); END Call4; END DynArr.
Another more low-level interface module called DynArrM2 reveals the internal data structure of Oberon-2 (H2O implementation) dynamic arrays and provides the abstraction necessary to deal with dynamic arrays in Modula-2, when no calling-convention compatible Oberon-2 compiler is available.

DynArrM2 additionally exports

The above additional procedures are necessary if you want to deal with dynamic arrays in Modula-2 at global level.

If you study the data structure of the dynamic arrays in the definition module DynArrM2, you'll notice a dummy data pointer to the first element of the dynamic array data[0,...,0]. This mechanism reflects the internal data structure of the H2O implementation of Oberon-2. This data-structure was choosen because then dynamic arrays and open array parameters could be handled identically in the Oberon-2 back-end (VAX/VMS code-generator).

Only the Call procedures which still make use of Oberon-2's implementation of DynArr.Call must be rewritten when module DynArrM2 is ported.

Contents, Module Set 3



DEFINITION MODULE DynArrM2; (* written in Modula-2 by Guenter Dotzel, 27-Mar-1993 Email: [email deleted due to spam] http://www.modulaware.com Low-level Oberon-2 dynamic array support for Modula-2 *) IMPORT SYSTEM; TYPE T1 = INTEGER; T2 = T1; T3 = T2; T4 = T3; R = [0..0]; TA1 = ARRAY R OF T1; TA2 = ARRAY R OF ARRAY R OF T2; TA3 = ARRAY R OF ARRAY R OF ARRAY R OF T3; TA4 = ARRAY R OF ARRAY R OF ARRAY R OF ARRAY R OF T4; DA1 = ARRAY [0..0] OF INTEGER; DA2 = ARRAY [0..1] OF INTEGER; DA3 = ARRAY [0..2] OF INTEGER; DA4 = ARRAY [0..3] OF INTEGER; A1 = POINTER TO RECORD dim: DA1; (* on AXP, the dim element size is 8 bytes *) datp: POINTER TO TA1; (* on AXP, this is a 64 bit address *) data: TA1; (* on AXP, this is rounded up to the next quadword *) END; A2 = POINTER TO RECORD dim: DA2; datp: POINTER TO TA2; data: TA2; END; A3 = POINTER TO RECORD dim: DA3; datp: POINTER TO TA3; data: TA3; END; A4 = POINTER TO RECORD dim: DA4; datp: POINTER TO TA4; data: TA4; END; CONST MaxIndex=MAX(INTEGER); ptr = SIZE(SYSTEM.ADDRESS); desc1= ptr+SIZE(DA1); desc2= ptr+SIZE(DA2); desc3= ptr+SIZE(DA3); desc4= ptr+SIZE(DA4); TYPE P1 = PROCEDURE (VAR ARRAY OF T1); P2 = PROCEDURE (VAR ARRAY OF ARRAY OF T2); P3 = PROCEDURE (VAR ARRAY OF ARRAY OF ARRAY OF T3); P4 = PROCEDURE (VAR ARRAY OF ARRAY OF ARRAY OF ARRAY OF T4); PROCEDURE New1(VAR a: A1; i0: INTEGER); PROCEDURE New2(VAR a: A2; i0, i1: INTEGER); PROCEDURE New3(VAR a: A3; i0, i1, i2: INTEGER); PROCEDURE New4(VAR a: A4; i0, i1, i2, i3: INTEGER); PROCEDURE Dispose1(VAR a: A1); PROCEDURE Dispose2(VAR a: A2); PROCEDURE Dispose3(VAR a: A3); PROCEDURE Dispose4(VAR a: A4); PROCEDURE Call1(a: A1; p: P1); PROCEDURE Call2(a: A2; p: P2); PROCEDURE Call3(a: A3; p: P3); PROCEDURE Call4(a: A4; p: P4); (* additional procedures to access dynamic arrays indirectly *) PROCEDURE Len1(a: A1; dim: INTEGER): INTEGER; PROCEDURE Len2(a: A2; dim: INTEGER): INTEGER; PROCEDURE Len3(a: A3; dim: INTEGER): INTEGER; PROCEDURE Len4(a: A4; dim: INTEGER): INTEGER; PROCEDURE Get1(a: A1; i0: INTEGER): T1; PROCEDURE Get2(a: A2; i0, i1: INTEGER): T2; PROCEDURE Get3(a: A3; i0, i1, i2: INTEGER): T3; PROCEDURE Get4(a: A4; i0, i1, i2, i3: INTEGER): T4; PROCEDURE Put1(a: A1; i0: INTEGER; v: T1); PROCEDURE Put2(a: A2; i0, i1: INTEGER; v: T2); PROCEDURE Put3(a: A3; i0, i1, i2: INTEGER; v: T3); PROCEDURE Put4(a: A4; i0, i1, i2, i3: INTEGER; v: T4); PROCEDURE Copy1(from: A1; VAR to: A1); PROCEDURE Copy2(from: A2; VAR to: A2); PROCEDURE Copy3(from: A3; VAR to: A3); PROCEDURE Copy4(from: A4; VAR to: A4); END DynArrM2.
MODULE TestDynArrM2; (* written in Modula-2 by Guenter Dotzel, 27-Mar-1993 Email: [email deleted due to spam] http://www.modulaware.com
TestDynArrM2 The implementation of imported module DynArrM2 is written in Modula-2. DynArrM2 serves to automatically convert dynamic array- to open array-descriptors when calling a procedure supplied as parameter which itself has a formal parameter of open array type.

If your Modula-2 compiler supports multi-dimensional open arrays, then you can take advantage of dynamic arrays too. (This programs compiles with ModulaWare's VAX/VMS Modula-2 Compiler V4.00 and up.)


*)
IMPORT DynArrM2, SWholeIO, STextIO;

VAR p: INTEGER;
  a1, b1, c1: DynArrM2.A1;
  a2, b2, c2: DynArrM2.A2;
  a3, b3, c3: DynArrM2.A3;
  a4, b4, c4: DynArrM2.A4;

PROCEDURE L1(VAR a: ARRAY OF DynArrM2.T1);
VAR j : INTEGER;
BEGIN
  FOR j := 0 TO HIGH(a) DO SWholeIO.WriteInt(a[j],6); END; STextIO.WriteLn;
END L1;

PROCEDURE L2(VAR a: ARRAY OF ARRAY OF DynArrM2.T2);
VAR k : INTEGER;
BEGIN
  FOR k := 0 TO HIGH(a) DO L1(a[k]); END; STextIO.WriteLn;
END L2;

PROCEDURE L3(VAR a: ARRAY OF ARRAY OF ARRAY OF DynArrM2.T3);
VAR l : INTEGER;
BEGIN
  FOR l := 0 TO HIGH(a) DO L2(a[l]); END; STextIO.WriteLn;
END L3;

PROCEDURE L4(VAR a: ARRAY OF ARRAY OF ARRAY OF ARRAY OF
  DynArrM2.T4);
VAR m : INTEGER;
BEGIN
  FOR m := 0 TO HIGH(a) DO L3(a[m]); END; STextIO.WriteLn;
END L4;

PROCEDURE P1(VAR a: ARRAY OF DynArrM2.T1);
VAR i0: INTEGER;
BEGIN
  FOR i0:=0 TO HIGH(a) DO a[i0]:=p; INC(p); END;
END P1;

PROCEDURE P2(VAR a: ARRAY OF ARRAY OF DynArrM2.T2);
VAR i0: INTEGER;
BEGIN
  FOR i0:=0 TO HIGH(a) DO P1(a[i0]); END;
END P2;

PROCEDURE P3(VAR a: ARRAY OF ARRAY OF ARRAY OF DynArrM2.T3);
VAR i0: INTEGER;
BEGIN
  FOR i0:=0 TO HIGH(a) DO P2(a[i0]); END;
END P3;

PROCEDURE P4(VAR a: ARRAY OF ARRAY OF ARRAY OF ARRAY OF
  DynArrM2.T4);
VAR i0: INTEGER;
BEGIN
  FOR i0:=0 TO HIGH(a) DO P3(a[i0]); END;
END P4;

PROCEDURE Check1(VAR a: ARRAY OF DynArrM2.T1);
VAR i0: INTEGER;
BEGIN
  IF (HIGH(a) # DynArrM2.Len1(c1,0)-1) THEN HALT END;
  FOR i0:=0 TO HIGH(a) DO
    IF a[i0] # DynArrM2.Get1(c1,i0) THEN HALT END;
  END;
END Check1;

PROCEDURE Check2(VAR a: ARRAY OF ARRAY OF DynArrM2.T2);
VAR i0,i1: INTEGER;
BEGIN
  IF (HIGH(a) # DynArrM2.Len2(c2,0)-1)
  OR (HIGH(a[0]) # DynArrM2.Len2(c2,1)-1) THEN HALT END;
  FOR i0:=0 TO HIGH(a) DO
    FOR i1:=0 TO HIGH(a[0]) DO
      IF a[i0,i1] # DynArrM2.Get2(c2,i0,i1) THEN HALT END;
    END;
  END;
END Check2;

PROCEDURE Check3(VAR a: ARRAY OF ARRAY OF ARRAY OF DynArrM2.T3);
VAR i0,i1,i2: INTEGER;
BEGIN
  IF (HIGH(a) # DynArrM2.Len3(c3,0)-1)
  OR (HIGH(a[0]) # DynArrM2.Len3(c3,1)-1)
  OR (HIGH(a[0,0]) # DynArrM2.Len3(c3,2)-1) THEN HALT END;
  FOR i0:=0 TO HIGH(a) DO
    FOR i1:=0 TO HIGH(a[0]) DO
      FOR i2:=0 TO HIGH(a[0,0]) DO
        IF a[i0,i1,i2] # DynArrM2.Get3(c3,i0,i1,i2) THEN HALT END;
      END;
    END;
  END;
END Check3;

PROCEDURE Check4(VAR a: ARRAY OF ARRAY OF ARRAY OF ARRAY OF
  DynArrM2.T4);
VAR i0,i1,i2,i3: INTEGER;
BEGIN
  IF (HIGH(a) # DynArrM2.Len4(c4,0)-1)
  OR (HIGH(a[0]) # DynArrM2.Len4(c4,1)-1)
  OR (HIGH(a[0,0]) # DynArrM2.Len4(c4,2)-1)
  OR (HIGH(a[0,0,0]) # DynArrM2.Len4(c4,3)-1) THEN HALT END;
  FOR i0:=0 TO HIGH(a) DO
    FOR i1:=0 TO HIGH(a[0]) DO
      FOR i2:=0 TO HIGH(a[0,0]) DO
        FOR i3:=0 TO HIGH(a[0,0,0]) DO
          IF a[i0,i1,i2,i3] # DynArrM2.Get4(c4,i0,i1,i2,i3) THEN HALT END;
        END;
      END;
    END;
  END;
END Check4;

BEGIN
  p:=0; (* global element assignment counter *)

  (* create set of dynamic arrays a *)
  DynArrM2.New1(a1, 5);
  DynArrM2.New2(a2, 5,4);
  DynArrM2.New3(a3, 5,4,3);
  DynArrM2.New4(a4, 5,4,3,2);

  (* create set of dynamic arrays b *)
  DynArrM2.New1(b1, 6);
  DynArrM2.New2(b2, 6,5);
  DynArrM2.New3(b3, 6,5,4);
  DynArrM2.New4(b4, 6,5,4,3);

  (* assign values to all elements of dynamic arrays a and b *)
  DynArrM2.Call1(a1,P1); DynArrM2.Call1(b1,P1);
  DynArrM2.Call2(a2,P2); DynArrM2.Call2(b2,P2);
  DynArrM2.Call3(a3,P3); DynArrM2.Call3(b3,P3);
  DynArrM2.Call4(a4,P4); DynArrM2.Call4(b4,P4);

  (* check all elements of dynamic arrays a and b*)
  c1:=a1; DynArrM2.Call1(c1,Check1);
  c1:=b1; DynArrM2.Call1(c1,Check1);
  c2:=a2; DynArrM2.Call2(c2,Check2);
  c2:=b2; DynArrM2.Call2(c2,Check2);
  c3:=a3; DynArrM2.Call3(c3,Check3);
  c3:=b3; DynArrM2.Call3(c3,Check3);
  c4:=a4; DynArrM2.Call4(c4,Check4);
  c4:=b4; DynArrM2.Call4(c4,Check4);

  (* display elements of dynamic arrays a and b;
     dispose a and clone b to a *)
  DynArrM2.Call1(a1,L1); DynArrM2.Dispose1(a1); DynArrM2.Copy1(b1,a1);
  DynArrM2.Call2(a2,L2); DynArrM2.Dispose2(a2); DynArrM2.Copy2(b2,a2);
  DynArrM2.Call3(a3,L3); DynArrM2.Dispose3(a3); DynArrM2.Copy3(b3,a3);
  DynArrM2.Call4(a4,L4); DynArrM2.Dispose4(a4); DynArrM2.Copy4(b4,a4);
  DynArrM2.Call1(b1,L1); DynArrM2.Dispose1(b1);
  DynArrM2.Call2(b2,L2); DynArrM2.Dispose2(b2);
  DynArrM2.Call3(b3,L3); DynArrM2.Dispose3(b3);
  DynArrM2.Call4(b4,L4); DynArrM2.Dispose4(b4);

  (* display elements of cloned dynamic arrays a *)
  DynArrM2.Call1(a1,L1); DynArrM2.Dispose1(a1);
  DynArrM2.Call2(a2,L2); DynArrM2.Dispose2(a2);
  DynArrM2.Call3(a3,L3); DynArrM2.Dispose3(a3);
  DynArrM2.Call4(a4,L4); DynArrM2.Dispose4(a4);

END TestDynArrM2.

IMPLEMENTATION MODULE DynArrM2; (* written in Modula-2 by Guenter Dotzel, 27-Mar-1993 Email: [email deleted due to spam] http://www.modulaware.com
Implementation notes: The Dispose procedures first clear the data pointer and set Len(a) to 0 to make sure that an access to a disposed dynamic array will crash.

Portation hint: If no Oberon-2 compiler is available to implement module DynArr, replace DynArr.Call by a call which pushes the dynamic array descriptor required for Modula-2's multi-dimensional open array parameters.


*)
IMPORT SYSTEM, DynArr, Storage;

PROCEDURE CheckBound(x, max: INTEGER);
BEGIN IF (x<0) OR (x>max) THEN HALT END;
END CheckBound;

PROCEDURE New1(VAR a: A1; i0: INTEGER);
BEGIN
  CheckBound(i0*SIZE(T1),MaxIndex);
  Storage.ALLOCATE(a, i0*SIZE(T1) + desc1);
  a^.datp:=SYSTEM.ADR(a^.data);
  a^.dim:=DA1{i0-1};
END New1;

PROCEDURE New2(VAR a: A2; i0, i1: INTEGER);
BEGIN
  CheckBound(i0*i1*SIZE(T2),MaxIndex);
  Storage.ALLOCATE(a, i0*i1*SIZE(T2) + desc2);
  a^.datp:=SYSTEM.ADR(a^.data);
  a^.dim:=DA2{i1-1,i0-1};
END New2;

PROCEDURE New3(VAR a: A3; i0, i1, i2: INTEGER);
BEGIN
  CheckBound(i0*i1*i2*SIZE(T3),MaxIndex);
  Storage.ALLOCATE(a, i0*i1*i2*SIZE(T3) + desc3);
  a^.datp:=SYSTEM.ADR(a^.data);
  a^.dim:=DA3{i2-1,i1-1,i0-1};
END New3;

PROCEDURE New4(VAR a: A4; i0, i1, i2, i3: INTEGER);
BEGIN
  CheckBound(i0*i1*i2*i3*SIZE(T4),MaxIndex);
  Storage.ALLOCATE(a, i0*i1*i2*i3*SIZE(T4) + desc4);
  a^.datp:=SYSTEM.ADR(a^.data);
  a^.dim:=DA4{i3-1,i2-1,i1-1,i0-1};
END New4;

PROCEDURE Len1(a: A1; dim: INTEGER): INTEGER;
BEGIN
  CheckBound(dim, 0);
  RETURN a^.dim[0]+1
END Len1;

PROCEDURE Len2(a: A2; dim: INTEGER): INTEGER;
BEGIN
  CheckBound(dim, 1);
  RETURN a^.dim[1-dim]+1
END Len2;

PROCEDURE Len3(a: A3; dim: INTEGER): INTEGER;
BEGIN
  CheckBound(dim, 2);
  RETURN a^.dim[2-dim]+1
END Len3;

PROCEDURE Len4(a: A4; dim: INTEGER): INTEGER;
BEGIN
  CheckBound(dim, 3);
  RETURN a^.dim[3-dim]+1
END Len4;

PROCEDURE Dispose1(VAR a: A1);
BEGIN
  a^.datp := NIL; a^.dim:=DA1{-1};
  Storage.DEALLOCATE(a, Len1(a,0)*SIZE(T1) + desc1);
END Dispose1;

PROCEDURE Dispose2(VAR a: A2);
BEGIN
  a^.datp := NIL; a^.dim:=DA2{-1,-1};
  Storage.DEALLOCATE(a, Len2(a,1)*Len2(a,0)*SIZE(T1) + desc2);
END Dispose2;

PROCEDURE Dispose3(VAR a: A3);
BEGIN
  a^.datp := NIL; a^.dim:=DA3{-1,-1,-1};
  Storage.DEALLOCATE(a, Len3(a,2)*Len3(a,1)*Len3(a,0)*SIZE(T1) + desc2);
END Dispose3;

PROCEDURE Dispose4(VAR a: A4);
BEGIN
  a^.datp := NIL; a^.dim:=DA4{-1,-1,-1,-1};
  Storage.DEALLOCATE(a, Len4(a,3)*Len4(a,2)*Len4(a,1)*Len4(a,0)*SIZE(T1) + des
c2);
END Dispose4;

PROCEDURE Call1(a: A1; p: P1);
VAR b: DynArr.A1;
BEGIN
  b:=SYSTEM.CAST(DynArr.A1,a);
  DynArr.Call1(b,SYSTEM.CAST(DynArr.P1,p));
END Call1;

PROCEDURE Call2(a: A2; p: P2);
VAR b: DynArr.A2;
BEGIN
  b:=SYSTEM.CAST(DynArr.A2,a);
  DynArr.Call2(b,SYSTEM.CAST(DynArr.P2,p));
END Call2;

PROCEDURE Call3(a: A3; p: P3);
VAR b: DynArr.A3;
BEGIN
  b:=SYSTEM.CAST(DynArr.A3,a);
  DynArr.Call3(b,SYSTEM.CAST(DynArr.P3,p));
END Call3;

PROCEDURE Call4(a: A4; p: P4);
VAR b: DynArr.A4;
BEGIN
  b:=SYSTEM.CAST(DynArr.A4,a);
  DynArr.Call4(b,SYSTEM.CAST(DynArr.P4,p));
END Call4;

PROCEDURE Get1(a: A1; i0: INTEGER): T1;
VAR p: POINTER TO T1;
BEGIN
  CheckBound(i0, a^.dim[0]);
  p := SYSTEM.ADDADR(SYSTEM.ADR(a^.data), 
    i0 * SIZE(T1));
  RETURN p^;
END Get1;

PROCEDURE Get2(a: A2; i0, i1: INTEGER): T2;
VAR p: POINTER TO T2;
BEGIN
  CheckBound(i0, a^.dim[1]);
  CheckBound(i1, a^.dim[0]);
  p := SYSTEM.ADDADR(SYSTEM.ADR(a^.data), 
    (i0 * (a^.dim[0]+1) + i1) * SIZE(T2));
  RETURN p^;
END Get2;

PROCEDURE Get3(a: A3; i0, i1, i2: INTEGER): T3;
VAR p: POINTER TO T3;
BEGIN
  CheckBound(i0, a^.dim[2]);
  CheckBound(i1, a^.dim[1]);
  CheckBound(i2, a^.dim[0]);
  p := SYSTEM.ADDADR( SYSTEM.ADR(a^.data), 
    ((i0 * (a^.dim[1]+1) + i1)*(a^.dim[0]+1)+i2) * SIZE(T3));
  RETURN p^;
END Get3;

PROCEDURE Get4(a: A4; i0, i1, i2, i3: INTEGER): T4;
VAR p: POINTER TO T4;
BEGIN
  CheckBound(i0, a^.dim[3]);
  CheckBound(i1, a^.dim[2]);
  CheckBound(i2, a^.dim[1]);
  CheckBound(i3, a^.dim[0]);
  p := SYSTEM.ADDADR( SYSTEM.ADR(a^.data), 
   (((i0 * (a^.dim[2]+1) + i1)*(a^.dim[1]+1)+i2)*(a^.dim[0]+1)+i3) * SIZE(T4));
  RETURN p^
END Get4;

PROCEDURE Put1(a: A1; i0: INTEGER; v: T1);
VAR p: POINTER TO T1;
BEGIN
  CheckBound(i0, a^.dim[0]);
  p := SYSTEM.ADDADR(SYSTEM.ADR(a^.data), 
    i0 * SIZE(T1));
  p^:=v;
END Put1;

PROCEDURE Put2(a: A2; i0, i1: INTEGER; v: T2);
VAR p: POINTER TO T2;
BEGIN
  CheckBound(i0, a^.dim[1]);
  CheckBound(i1, a^.dim[0]);
  p := SYSTEM.ADDADR(SYSTEM.ADR(a^.data), 
    (i0 * (a^.dim[0]+1) + i1) * SIZE(T2));
  p^:=v;
END Put2;

PROCEDURE Put3(a: A3; i0, i1, i2: INTEGER; v: T3);
VAR p: POINTER TO T3;
BEGIN
  CheckBound(i0, a^.dim[2]);
  CheckBound(i1, a^.dim[1]);
  CheckBound(i2, a^.dim[0]);
  p := SYSTEM.ADDADR( SYSTEM.ADR(a^.data), 
    ((i0 * (a^.dim[1]+1) + i1)*(a^.dim[0]+1)+i2) * SIZE(T3));
  p^:=v;
END Put3;

PROCEDURE Put4(a: A4; i0, i1, i2, i3: INTEGER; v: T4);
VAR p: POINTER TO T4;
BEGIN
  CheckBound(i0, a^.dim[3]);
  CheckBound(i1, a^.dim[2]);
  CheckBound(i2, a^.dim[1]);
  CheckBound(i3, a^.dim[0]);
  p := SYSTEM.ADDADR( SYSTEM.ADR(a^.data), 
   (((i0 * (a^.dim[2]+1) + i1)*(a^.dim[1]+1)+i2)*(a^.dim[0]+1)+i3) * SIZE(T4));
  p^:=v;
END Put4;

PROCEDURE Copy1(from: A1; VAR to: A1);
VAR i0: INTEGER;
BEGIN
  New1(to, Len1(from,0));   FOR i0:=0 TO Len1(to,0)-1 DO
    Put1(to, i0, Get1(from, i0));
  END;
END Copy1;

PROCEDURE Copy2(from: A2; VAR to: A2);
VAR i0,i1: INTEGER;
BEGIN
  New2(to, Len2(from,0), Len2(from,1));
  FOR i0:=0 TO Len2(to,0)-1 DO
    FOR i1:=0 TO Len2(to,1)-1 DO
      Put2(to, i0,i1, Get2(from, i0,i1));
    END;
  END;
END Copy2;

PROCEDURE Copy3(from: A3; VAR to: A3);
VAR i0,i1,i2: INTEGER;
BEGIN
  New3(to, Len3(from,0), Len3(from,1), Len3(from,2));
  FOR i0:=0 TO Len3(to,0)-1 DO
    FOR i1:=0 TO Len3(to,1)-1 DO
      FOR i2:=0 TO Len3(to,2)-1 DO
        Put3(to, i0,i1,i2, Get3(from, i0,i1,i2));
      END;
    END;
  END;
END Copy3;

PROCEDURE Copy4(from: A4; VAR to: A4);
VAR i0,i1,i2,i3: INTEGER;
BEGIN
  New4(to, Len4(from,0), Len4(from,1), Len4(from,2), Len4(from,3));
  FOR i0:=0 TO Len4(to,0)-1 DO
    FOR i1:=0 TO Len4(to,1)-1 DO
      FOR i2:=0 TO Len4(to,2)-1 DO
        FOR i3:=0 TO Len4(to,3)-1 DO
          Put4(to, i0,i1,i2,i3, Get4(from, i0,i1,i2,i3));
        END;
      END;
    END;
  END;
END Copy4;

END DynArrM2.

Well, the Copy procedures in module DynArrM2 look like sunday funnys, because they need two procedure calls Put(..., Get(...)) to assign a value for each element of the dynamic array to be copied. To speed this up, let's explore two other methods.

1. The first method uses the so-called indirect call technique with a procedure parameter, introduced in module DynArr above. In order to copy two arrays in a procedure, we need two open array parameters. This means, we can't use DynArr.Copy which expects as parameters one dynamic array and a procedure to be called with that array.

So we need another set of Call procedures who take as parameters two dynamic arrays and a procedure parameter of type PCx with x = [0..3] with the generic Modula-2 declaration

TYPE PCx = PROCEDURE ( VAR {ARRAY OF }x+1 Tx, VAR {ARRAY OF } x+1 Tx);

PROCEDURE CallCx (VAR from, to: DynArr.Ax; p: PCx);

In Oberon-2 as well as Modula-2, two procedures are compatible if they are structural identical. In Oberon-2 the procedure type declaration has the same syntax as the procedure declaration itself (note the parameter names):

TYPE PCx* = PROCEDURE (VAR from, to: {ARRAY OF } x+1 Tx);

And by putting the type declaration into the procedure header (this feature is not available in Modula-2) we need not introduce a new set procedure types PCx. So we end up with the follwing header of the new Copy procedures with the generic Oberon-2 declaration:

PROCEDURE CallCx* (VAR from, to: DynArr.Ax; p: PROCEDURE (VAR from, to: {ARRAY OF }x+1 Tx);

2. The second method to speed up the copying uses SYSTEM.MOVE, another feature of Oberon-2 not available in the Modula-2 language.

Although both methods have different abstraction level, I combine the Oberon-2 support mechanisms for method 1 and 2 into module DynArrC, because they serve to implement faster dynamic array Copy procedures.

Contents, Module Set 4



DEFINITION MODULE DynArrC; (* written in Modula-2 by Guenter Dotzel, 29-Mar-1993 Email: [email deleted due to spam] http://www.modulaware.com Modula-2 interface module for DynArrC.Mod written in Oberon-2 *) IMPORT DynArrM2, SYSTEM; TYPE A1=DynArrM2.A1; A2=DynArrM2.A2; A3=DynArrM2.A3; A4=DynArrM2.A4; T1 = DynArrM2.T1; T2 = DynArrM2.T1; T3 = DynArrM2.T2; T4 = DynArrM2.T3; PC1 = PROCEDURE (VAR ARRAY OF T1, VAR ARRAY OF T1); PC2 = PROCEDURE (VAR ARRAY OF ARRAY OF T2, VAR ARRAY OF ARRAY OF T2); PC3 = PROCEDURE (VAR ARRAY OF ARRAY OF ARRAY OF T3, VAR ARRAY OF ARRAY OF ARRAY OF T3); PC4 = PROCEDURE ( VAR ARRAY OF ARRAY OF ARRAY OF ARRAY OF T4, VAR ARRAY OF ARRAY OF ARRAY OF ARRAY OF T4); PROCEDURE Call1(a,b: A1; P: PC1); PROCEDURE Call2(a,b: A2; P: PC2); PROCEDURE Call3(a,b: A3; P: PC3); PROCEDURE Call4(a,b: A4; P: PC4); PROCEDURE MOVE(from, to: SYSTEM.ADDRESS; bytes: INTEGER); END DynArrC.
MODULE DynArrC; (* written in Oberon-2 by Guenter Dotzel, 29-Mar-1993 Email: [email deleted due to spam] http://www.modulaware.com *) IMPORT DynArr, SYSTEM; TYPE A1* = DynArr.A1; A2* = DynArr.A2; A3* = DynArr.A3; A4* = DynArr.A4; T1* = DynArr.T1; T2* = DynArr.T1; T3* = DynArr.T2; T4* = DynArr.T3; PROCEDURE Call1*(a,b: A1; P: PROCEDURE (VAR a,b: ARRAY OF T1)); BEGIN P(a^,b^); END Call1; PROCEDURE Call2*(a,b: A2; P: PROCEDURE (VAR a,b: ARRAY OF ARRAY OF T2)); BEGIN P(a^,b^); END Call2; PROCEDURE Call3*(a,b: A3; P: PROCEDURE (VAR a,b: ARRAY OF ARRAY OF ARRAY OF T3)); BEGIN P(a^,b^); END Call3; PROCEDURE Call4*(a,b: A4; P: PROCEDURE (VAR a,b: ARRAY OF ARRAY OF ARRAY OF ARRAY OF T4)); BEGIN P(a^,b^); END Call4; PROCEDURE MOVE*(from, to: SYSTEM.PTR; bytes: LONGINT); BEGIN SYSTEM.MOVE(from, to, bytes); END MOVE; END DynArrC.
DEFINITION MODULE DynArrM2C; (* written in Modula-2 by Guenter Dotzel, 29-Mar-1993 Email: [email deleted due to spam] http://www.modulaware.com Oberon-2 dynamic array copy support for Modula-2 *) IMPORT DynArrM2; TYPE A1=DynArrM2.A1; A2=DynArrM2.A2; A3=DynArrM2.A3; A4=DynArrM2.A4; PROCEDURE Copy1(from: A1; VAR to: A1); PROCEDURE Copy2(from: A2; VAR to: A2); PROCEDURE Copy3(from: A3; VAR to: A3); PROCEDURE Copy4(from: A4; VAR to: A4); PROCEDURE CopyM1(from: A1; VAR to: A1); PROCEDURE CopyM2(from: A2; VAR to: A2); PROCEDURE CopyM3(from: A3; VAR to: A3); PROCEDURE CopyM4(from: A4; VAR to: A4); END DynArrM2C.
IMPLEMENTATION MODULE DynArrM2C; (* written in Modula-2 by Guenter Dotzel, 29-Mar-1993 Email: [email deleted due to spam] http://www.modulaware.com CopyMx procedures corrected in order not to copy the descriptor but only the data. GD/29-Mar-1993 15:00 *) IMPORT DynArrC, DynArrM2; TYPE T1 = DynArrM2.T1; T2 = DynArrM2.T1; T3 = DynArrM2.T3; T4 = DynArrM2.T4; PROCEDURE C1 (VAR from, to: ARRAY OF T1); VAR i0: INTEGER; BEGIN FOR i0:=0 TO HIGH(to) DO to[i0]:=from[i0]; END; END C1; PROCEDURE C2(VAR from, to: ARRAY OF ARRAY OF T2); VAR i0,i1: INTEGER; BEGIN FOR i0:=0 TO HIGH(to) DO FOR i1:=0 TO HIGH(to[0]) DO to[i0,i1] := from[i0,i1]; END; END; END C2; PROCEDURE C3(VAR from, to: ARRAY OF ARRAY OF ARRAY OF T3); VAR i0,i1,i2: INTEGER; BEGIN FOR i0:=0 TO HIGH(to) DO FOR i1:=0 TO HIGH(to[0]) DO FOR i2:=0 TO HIGH(to[0,0]) DO to[i0,i1,i2] := from [i0,i1,i2]; END; END; END; END C3; PROCEDURE C4(VAR from, to: ARRAY OF ARRAY OF ARRAY OF ARRAY OF T4); VAR i0,i1,i2,i3: INTEGER; BEGIN FOR i0:=0 TO HIGH(to) DO FOR i1:=0 TO HIGH(to[0]) DO FOR i2:=0 TO HIGH(to[0,0]) DO FOR i3:=0 TO HIGH(to[0,0,0]) DO to[i0,i1,i2,i3] := from[i0,i1,i2,i3]; END; END; END; END; END C4; PROCEDURE Copy1(from: A1; VAR to: A1); BEGIN DynArrM2.New1(to, DynArrM2.Len1(from,0)); DynArrC.Call1(from, to, C1); END Copy1; PROCEDURE Copy2(from: A2; VAR to: A2); BEGIN DynArrM2.New2(to, DynArrM2.Len2(from,0), DynArrM2.Len2(from,1)); DynArrC.Call2(from, to, C2); END Copy2; PROCEDURE Copy3(from: A3; VAR to: A3); BEGIN DynArrM2.New3(to, DynArrM2.Len3(from,0), DynArrM2.Len3(from,1), DynArrM2.Len3(from,2)); DynArrC.Call3(from, to, C3); END Copy3; PROCEDURE Copy4(from: A4; VAR to: A4); BEGIN DynArrM2.New4(to, DynArrM2.Len4(from,0), DynArrM2.Len4(from,1), DynArrM2.Len4(from,2), DynArrM2.Len4(from,3)); DynArrC.Call4(from, to, C4); END Copy4; PROCEDURE CopyM1(from: A1; VAR to: A1); VAR i0: INTEGER; BEGIN i0:=DynArrM2.Len1(from,0); DynArrM2.New1(to, i0); DynArrC.MOVE(from^.datp, to^.datp, i0*SIZE(T1)); END CopyM1; PROCEDURE CopyM2(from: A2; VAR to: A2); VAR i0,i1: INTEGER; BEGIN i0:=DynArrM2.Len2(from,0); i1:=DynArrM2.Len2(from,1); DynArrM2.New2(to, i0,i1); DynArrC.MOVE(from^.datp, to^.datp, i0*i1*SIZE(T2)); END CopyM2; PROCEDURE CopyM3(from: A3; VAR to: A3); VAR i0,i1,i2: INTEGER; BEGIN i0:=DynArrM2.Len3(from,0); i1:=DynArrM2.Len3(from,1); i2:=DynArrM2.Len3(from,2); DynArrM2.New3(to, i0,i1,i2); DynArrC.MOVE(from^.datp, to^.datp, i0*i1*i2*SIZE(T3)); END CopyM3; PROCEDURE CopyM4(from: A4; VAR to: A4); VAR i0,i1,i2,i3: INTEGER; BEGIN i0:=DynArrM2.Len4(from,0); i1:=DynArrM2.Len4(from,1); i2:=DynArrM2.Len4(from,2); i3:=DynArrM2.Len4(from,3); DynArrM2.New4(to, i0,i1,i2,i3); DynArrC.MOVE(from^.datp, to^.datp, i0*i1*i2*i3*SIZE(T4)); END CopyM4; END DynArrM2C.
To take advantage of the new Copy procedures, simply replace the procedure calls to DynArrM2.Copy by either DynArrM2C.Copy or DynArrM2C.CopyM in TestDynArrM2.

IMPRESSUM: The ModulaTor is an unrefereed journal. Technical papers are to be taken as working papers and personal rather than organizational statements. Items are printed at the discretion of the Editor based upon his judgement on the interest and relevancy to the readership. Letters, announcements, and other items of professional interest are selected on the same basis. Office of publication. The Editor of The ModulaTor is Günter Dotzel; he can be reached at mailto:[email deleted due to spam]


Home | Site_index | Legal | OpenVMS_compiler | Alpha_Oberon_System | ModulaTor | Bibliography | Oberon[-2]_links | Modula-2_links |

Amazon.com [3KB] [Any browser]

Books Music Video Enter keywords...


Amazon.com logo

Webdesign by www.otolo.com/webworx, 16-Dec-1998