1MODULE MultiArrays; (** P. Hunziker, Basel, **) 2(** 3AIM: To provide a library solution for 4a multidimensional array type for numbers of arbitrary dimensions, 5with the following features: 6 -compatible types for 1,2,3..n dimensions, allowing exchangeable use in procedure headers etc 7 -> generic/OO procedures for multidimensional array handling can be implemented 8 -arrays can be accessed in multiple ways: 9 -a) conventional indexing (though not by using brackets[ ], but using procedure IndexN. ) 10 -b) in a linear fashion (fast) 11 -c) using an "ALL()" procedure without need for index handling by the user (very fast !) 12 -d) using array riders movable along arbitrary axis (Module MultiArrayRiders) 13 -e) by reading "runs" of data with rider (Module MultiArrayRiders) 14 15A type 'scalar' is also based on the same base type as arrays, to allow mixing of arrays and scalars 16in procedure headers, for more generic procedure headers when e.g. defining array operations: 17(e.g. PROCEDURE Add(d1, d2: Data): Data; 18 can be used for mixed expressions of arrays and numbers). 19 This is in the hope that a family of array handling modules similar to the functionality of 20 MATLAB or APL will be based on these types in the future. (Help is welcome !). 21 22 See 'Test', 'Test1', procedures in both modules for insight how to use them. 23*) 24 25 26(** Copyright 1999-2001, Patrick Hunziker 27 28 This library is free software; you can redistribute it and/or modify it under the terms of the 29 GNU Library General Public License as published by the Free Software Foundation; 30 either version 2 of the License, or any later version. 31 32 This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 33 without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 34 See the GNU Library General Public License for more details. 35 36 You should have received a copy of the GNU Library General Public License along with this library; 37 if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 38 39Patrick Hunziker,Basel. 40email Patrick.Hunziker@unibas.ch 41*) 42(** Version 0.9, 19.1.2001 *) 43IMPORT Out := Console, Input := Platform; (* Import only needed for Demo purposes *) 44 45TYPE 46 SIntPtr* = POINTER TO ARRAY OF SHORTINT; 47 IntPtr* = POINTER TO ARRAY OF INTEGER; 48 LIntPtr* = POINTER TO ARRAY OF LONGINT; 49(* HIntPtr* = POINTER TO ARRAY OF HUGEINT; *) 50 RealPtr* = POINTER TO ARRAY OF REAL; 51 LRealPtr* = POINTER TO ARRAY OF LONGREAL; 52 BoolPtr* = POINTER TO ARRAY OF BOOLEAN; 53(* ComplxPtr* = POINTER TO ARRAY OF COMPLEX; *) 54 55 Data* = POINTER TO DataDesc; (** abstract base type, not containing data. 56 This could be an Objects.Object for S3 *) 57 DataDesc* = RECORD END; 58 59 Scalar* = POINTER TO ScalarDesc; (** abstract base type, not containing data. *) 60 ScalarDesc* = RECORD (DataDesc) END; 61 62 SInt* = POINTER TO SIntDesc; 63 SIntDesc* = RECORD (ScalarDesc) 64 s*: SHORTINT; 65 END; 66 67 Int* = POINTER TO IntDesc; 68 IntDesc* = RECORD (ScalarDesc) 69 i*: INTEGER; 70 END; 71 72 LInt* = POINTER TO LIntDesc; 73 LIntDesc* = RECORD (ScalarDesc) 74 j*: LONGINT; 75 END; 76 77(* HInt* = POINTER TO HIntDesc; 78 HIntDesc* = RECORD (ScalarDesc) 79 h*: HUGEINT; 80 END; 81*) 82 Real* = POINTER TO RealDesc; 83 RealDesc* = RECORD (ScalarDesc) 84 x*: REAL; 85 END; 86 87 LReal* = POINTER TO LRealDesc; 88 LRealDesc* = RECORD (ScalarDesc) 89 y*: LONGREAL; 90 END; 91 92 Bool* = POINTER TO BoolDesc; 93 BoolDesc* = RECORD (ScalarDesc) 94 b*: BOOLEAN; 95 END; 96 97 Complex* = POINTER TO ComplexDesc; 98 ComplexDesc* = RECORD (ScalarDesc) 99 r*, i*: REAL; 100 END; 101 102 SizeVector* = POINTER TO SizeVectorDesc; (* used for description of array size; eventually = CATLIntVector *) 103 SizeVectorDesc* = ARRAY OF LONGINT; 104 105 Array* = POINTER TO ArrayDesc; (** abstract base type, not containing data *) 106 ArrayDesc* = RECORD (DataDesc) 107 (*ARRAY of arbitrary dimensionality *) 108 dimension: SizeVector; (* dimension vector *) 109 len-: LONGINT; (* Overall number of array elements *) 110 END; 111 112 SIntArray* = POINTER TO SIntArrayDesc; 113 SIntArrayDesc* = RECORD (ArrayDesc) 114 s-: SIntPtr; 115 END; 116 117 IntArray* = POINTER TO IntArrayDesc; 118 IntArrayDesc* = RECORD (ArrayDesc) 119 i-: IntPtr; 120 END; 121 122 LIntArray* = POINTER TO LIntArrayDesc; 123 LIntArrayDesc* = RECORD (ArrayDesc) 124 j-: LIntPtr; 125 END; 126 127(* HIntArray* = POINTER TO HIntArrayDesc; 128 HIntArrayDesc* = RECORD (ArrayDesc) 129 h-: HIntPtr; 130 END; 131*) 132 RealArray* = POINTER TO RealArrayDesc; 133 RealArrayDesc* = RECORD (ArrayDesc) 134 x-: RealPtr; 135 END; 136 137 LRealArray* = POINTER TO LRealArrayDesc; 138 LRealArrayDesc* = RECORD (ArrayDesc) 139 y-: LRealPtr; 140 END; 141 142 BoolArray* = POINTER TO BoolArrayDesc; 143 BoolArrayDesc* = RECORD (ArrayDesc) 144 b-: BoolPtr; 145 END; 146 147 ComplexArray* = POINTER TO ComplexArrayDesc; 148 ComplexArrayDesc* = RECORD (ArrayDesc) 149 r-, i-: RealPtr; 150 END; 151 152 PROCEDURE Order* (A: Array): LONGINT; 153 (** returns Nr of dimensions of array A *) 154 BEGIN 155 RETURN LEN(A.dimension^) 156 END Order; 157 158 PROCEDURE Size* (A: Array): SizeVector; 159 (** returns dimension vector *) 160 VAR i: LONGINT; res: SizeVector; 161 BEGIN 162 NEW(res,LEN(A.dimension^)); 163 FOR i := 0 TO LEN(A.dimension^)-1 DO res[i] := A.dimension[i] END; 164 RETURN res 165 END Size; 166 167 PROCEDURE Len* (A: Array; dim: LONGINT): LONGINT; 168 (** returns length of dimension Nr 'dim' *) 169 BEGIN 170 IF dim >= LEN(A.dimension^) THEN HALT(100) 171 ELSE RETURN A.dimension[dim] 172 END 173 END Len; 174 175 PROCEDURE Index*(pos, dimension: ARRAY OF LONGINT): LONGINT; 176 VAR maxI,res,i: LONGINT; 177 BEGIN 178 maxI := LEN(dimension)-1; 179 ASSERT(LEN(pos) = LEN(dimension)); 180 res := pos[maxI]; 181 FOR i := 1 TO maxI DO res := res*dimension[maxI-i]+pos[maxI-i] END; 182 RETURN res 183 END Index; 184 185 PROCEDURE Index1*(A: Array; x: LONGINT): LONGINT; 186 BEGIN 187 ASSERT(Order(A) = 1); 188 ASSERT(x < A.len); 189 RETURN x 190 END Index1; 191 192 PROCEDURE Index2*(A: Array; x,y: LONGINT): LONGINT; 193 BEGIN 194 ASSERT(Order(A) = 2); 195 ASSERT(x < Len(A,0)); 196 ASSERT(y < Len(A,1)); 197 RETURN y*Len(A,0)+x 198 END Index2; 199 200 PROCEDURE Index3*(A: Array; x,y,z: LONGINT): LONGINT; 201 BEGIN 202 ASSERT(Order(A) = 3); 203 ASSERT(x < Len(A,0)); 204 ASSERT(y < Len(A,1)); 205 ASSERT(z < Len(A,2)); 206 RETURN (z*Len(A,1)+y)*Len(A,0)+x 207 END Index3; 208 209 PROCEDURE Index4*(A: Array; x,y,z,u: LONGINT): LONGINT; 210 BEGIN 211 ASSERT(Order(A) = 4); 212 ASSERT(x < Len(A,0)); 213 ASSERT(y < Len(A,1)); 214 ASSERT(z < Len(A,2)); 215 ASSERT(u < Len(A,3)); 216 RETURN ((u*Len(A,2)+z)*Len(A,1)+y)*Len(A,0)+x 217 END Index4; 218 219 PROCEDURE SizeVector1*(VAR Vec: SizeVector; x: LONGINT); 220 BEGIN 221 IF (Vec=NIL) OR (LEN(Vec^)#1) THEN NEW(Vec,1) END; 222 Vec[0] := x 223 END SizeVector1; 224 225 PROCEDURE SizeVector2*(VAR Vec: SizeVector; x,y: LONGINT); 226 BEGIN 227 IF (Vec=NIL) OR (LEN(Vec^)#2) THEN NEW(Vec,2) END; 228 Vec[0] := x; Vec[1] := y 229 END SizeVector2; 230 231 PROCEDURE SizeVector3*(VAR Vec: SizeVector; x,y,z: LONGINT); 232 BEGIN 233 IF (Vec=NIL) OR (LEN(Vec^)#3) THEN NEW(Vec,3) END; 234 Vec[0] := x; Vec[1] := y; Vec[2] := z 235 END SizeVector3; 236 237 PROCEDURE SizeVector4*(VAR Vec: SizeVector; x,y,z,u: LONGINT); 238 BEGIN 239 IF (Vec=NIL) OR (LEN(Vec^)#4) THEN NEW(Vec,4) END; 240 Vec[0] := x; Vec[1] := y; Vec[2] := z; Vec[3] := u 241 END SizeVector4; 242 243 PROCEDURE CalculatePos*(Index: LONGINT; dimension: ARRAY OF LONGINT): SizeVector; 244 VAR maxI, n, i: LONGINT; 245 res: SizeVector; 246 BEGIN 247 n := Index; 248 maxI := LEN(dimension)-1; 249 FOR i := 0 TO maxI-1 DO 250 res[maxI-i] := n MOD dimension[maxI-i]; 251 n := n DIV dimension[maxI-i] 252 END; 253 RETURN res 254 END CalculatePos; 255 256 PROCEDURE InitSInt* (VAR A: Array; dimension: SizeVector; data: SIntPtr; copy: BOOLEAN); 257 VAR i, n: LONGINT; 258 AA: SIntArray; 259 BEGIN 260 IF (A=NIL) OR ~(A IS SIntArray) THEN NEW(AA) ELSE IF A IS SIntArray THEN AA := A(SIntArray) END END; 261 n := 1; 262 FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END; 263 IF data=NIL THEN NEW(data,n); copy := FALSE END; 264 ASSERT (LEN(data^)=n); 265 NEW(AA.dimension,LEN(dimension^)); 266 FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END; 267 AA.len := n; 268 IF copy 269 THEN NEW (AA.s,n); FOR i := 0 TO n-1 DO AA.s[i] := data[i] END; 270 ELSE AA.s := data 271 END; 272 A := AA 273 END InitSInt; 274 275 PROCEDURE InitInt* (VAR A: Array; dimension: SizeVector; data: IntPtr; copy: BOOLEAN); 276 VAR i, n: LONGINT; 277 AA: IntArray; 278 BEGIN 279 IF (A=NIL) OR ~(A IS IntArray) THEN NEW(AA) ELSE IF A IS IntArray THEN AA := A(IntArray) END END; 280 n := 1; 281 FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END; 282 IF data=NIL THEN NEW(data,n); copy := FALSE END; 283 ASSERT (LEN(data^)=n); 284 NEW(AA.dimension,LEN(dimension^)); 285 FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END; 286 AA.len := n; 287 IF copy 288 THEN NEW (AA.i,n); FOR i := 0 TO n-1 DO AA.i[i] := data[i] END; 289 ELSE AA.i := data 290 END; 291 A := AA 292 END InitInt; 293 294 PROCEDURE InitLInt* (VAR A: Array; dimension: SizeVector; data: LIntPtr; copy: BOOLEAN); 295 VAR i, n: LONGINT; 296 AA: LIntArray; 297 BEGIN 298 IF (A=NIL) OR ~(A IS LIntArray) THEN NEW(AA) ELSE IF A IS LIntArray THEN AA := A(LIntArray) END END; 299 n := 1; 300 FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END; 301 IF data=NIL THEN NEW(data,n); copy := FALSE END; 302 ASSERT (LEN(data^)=n); 303 NEW(AA.dimension,LEN(dimension^)); 304 FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END; 305 AA.len := n; 306 IF copy 307 THEN NEW (AA.j,n); FOR i := 0 TO n-1 DO AA.j[i] := data[i] END; 308 ELSE AA.j := data 309 END; 310 A := AA 311 END InitLInt; 312 313(* PROCEDURE InitHInt* (VAR A: Array; dimension: SizeVector; data: HIntPtr; copy: BOOLEAN); 314 VAR i, n: LONGINT; 315 AA: HIntArray; 316 BEGIN 317 IF (A=NIL) OR ~(A IS HIntArray) THEN NEW(AA) ELSE WITH A: HIntArray DO AA := A END END; 318 n := 1; 319 FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END; 320 IF data=NIL THEN NEW(data,n); copy := FALSE END; 321 ASSERT (LEN(data^)=n); 322 NEW(AA.dimension,LEN(dimension^)); 323 FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END; 324 AA.len := n; 325 IF copy 326 THEN NEW (AA.h,n); FOR i := 0 TO n-1 DO AA.h[i] := data[i] END; 327 ELSE AA.h := data 328 END; 329 A := AA 330 END InitHInt; *) 331 332 PROCEDURE InitReal* (VAR A: Array; dimension: SizeVector; data: RealPtr; copy: BOOLEAN); 333 VAR i, n:LONGINT; 334 AA:RealArray; 335 BEGIN 336 IF (A=NIL) OR ~(A IS RealArray) THEN NEW(AA) ELSE IF A IS RealArray THEN AA := A(RealArray) END END; 337 n := 1; 338 FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END; 339 IF data=NIL THEN NEW(data,n); copy := FALSE END; 340 ASSERT (LEN(data^)=n); 341 NEW(AA.dimension,LEN(dimension^)); 342 FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END; 343 AA.len := n; 344 IF copy 345 THEN NEW (AA.x,n); FOR i := 0 TO n-1 DO AA.x[i] := data[i] END; 346 ELSE AA.x := data 347 END; 348 A := AA 349 END InitReal; 350 351 PROCEDURE InitLReal* (VAR A: Array; dimension: SizeVector; data: LRealPtr; copy: BOOLEAN); 352 VAR i, n: LONGINT; 353 AA: LRealArray; 354 BEGIN 355 IF (A=NIL) OR ~(A IS LRealArray) THEN NEW(AA) ELSE IF A IS LRealArray THEN AA := A(LRealArray) END END; 356 n := 1; 357 FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END; 358 IF data=NIL THEN NEW(data,n); copy := FALSE END; 359 ASSERT (LEN(data^)=n); 360 NEW(AA.dimension,LEN(dimension^)); 361 FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END; 362 AA.len := n; 363 IF copy 364 THEN NEW (AA.y,n); FOR i := 0 TO n-1 DO AA.y[i] := data[i] END; 365 ELSE AA.y := data 366 END; 367 A := AA 368 END InitLReal; 369 370 PROCEDURE InitBool* (VAR A: Array; dimension: SizeVector; data: BoolPtr; copy: BOOLEAN); 371 VAR i, n: LONGINT; 372 AA: BoolArray; 373 BEGIN 374 IF (A=NIL) OR ~(A IS BoolArray) THEN NEW(AA) ELSE IF A IS BoolArray THEN AA := A(BoolArray) END END; 375 n := 1; 376 FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END; 377 IF data=NIL THEN NEW(data,n); copy := FALSE END; 378 ASSERT (LEN(data^)=n); 379 NEW(AA.dimension,LEN(dimension^)); 380 FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END; 381 AA.len := n; 382 IF copy 383 THEN NEW (AA.b,n); FOR i := 0 TO n-1 DO AA.b[i] := data[i] END 384 ELSE AA.b := data 385 END; 386 A := AA 387 END InitBool; 388 389 PROCEDURE InitComplex* (VAR A:Array; dimension: SizeVector; 390 dataR,dataI: RealPtr; copy:BOOLEAN); 391 VAR i, n: LONGINT; 392 AA: ComplexArray; 393 BEGIN 394 IF (A=NIL) OR ~(A IS ComplexArray) THEN NEW(AA) ELSE IF A IS ComplexArray THEN AA := A(ComplexArray) END END; 395 n := 1; 396 FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END; 397 ASSERT (LEN(dataR^)=n); ASSERT (LEN(dataI^)=n); 398 NEW(AA.dimension,LEN(dimension^)); 399 FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END; 400 AA.len := n; 401 IF copy 402 THEN NEW (AA.r,n); NEW (AA.i,n); 403 FOR i := 0 TO n-1 DO AA.r[i] := dataR[i]; AA.i[i] := dataI[i] END 404 ELSE AA.r := dataR; AA.i := dataI 405 END; 406 A := AA 407 END InitComplex; 408 409 PROCEDURE Copy* (From,To:Array); 410 BEGIN 411 WITH 412 From: SIntArray DO InitSInt(To,From.dimension,From.s,TRUE) ; 413 | From: IntArray DO InitInt(To,From.dimension,From.i,TRUE); 414 | From: LIntArray DO InitLInt(To,From.dimension,From.j,TRUE); 415 (* | From: HIntArray DO HALT(100) *) 416 | From: RealArray DO InitReal(To,From.dimension,From.x,TRUE); 417 | From: LRealArray DO InitLReal(To,From.dimension,From.y,TRUE); 418 | From: BoolArray DO InitBool(To,From.dimension,From.b,TRUE); 419 | From: ComplexArray DO InitComplex(To,From.dimension,From.r,From.i,TRUE); 420 ELSE HALT(100) 421 END 422 END Copy; 423 424(* PROCEDURE CopySubArray* (A1,A2:Array; start,dimension:ARRAY OF LONGINT); 425 (** Copies subrange of Array A1, beginning at 'start' with 'dimension' to (usually smaller) array A2 *) 426 BEGIN 427 WITH A1: ... 428 ELSE HALT(100) 429 END 430 END CopySubarray; *) 431 432 PROCEDURE GetSInt* (A: Array; position: SizeVector): SHORTINT; 433 BEGIN 434 IF A IS SIntArray THEN RETURN A(SIntArray).s[Index(position^,A.dimension^)] 435 ELSE HALT (100) END 436 END GetSInt; 437 438 PROCEDURE GetInt* (A: Array; position: SizeVector): INTEGER; 439 BEGIN 440 IF A IS IntArray THEN RETURN A(IntArray).i[Index(position^,A.dimension^)] 441 ELSE HALT (100) END 442 END GetInt; 443 444 PROCEDURE GetLInt* (A: Array; position: SizeVector): LONGINT; 445 BEGIN 446 IF A IS LIntArray THEN RETURN A(LIntArray).j[Index(position^,A.dimension^)] 447 ELSE HALT (100) END 448 END GetLInt; 449 450 (*PROCEDURE GetHInt* (A: Array; position: SizeVector): HUGEINT; 451 BEGIN 452 IF A IS HIntArray THEN RETURN A(HIntArray).h[Index(position^,A.dimension^)] 453 ELSE HALT (100) END 454 END GetHInt; *) 455 456 PROCEDURE GetReal* (A: Array; position: SizeVector): REAL; 457 BEGIN 458 IF A IS RealArray THEN RETURN A(RealArray).x[Index(position^,A.dimension^)] 459 ELSE HALT (100) END 460 END GetReal; 461 462 PROCEDURE GetLReal* (A: Array; position: SizeVector): LONGREAL; 463 BEGIN 464 IF A IS LRealArray THEN RETURN A(LRealArray).y[Index(position^,A.dimension^)] 465 ELSE HALT (100) END 466 END GetLReal; 467 468 PROCEDURE GetBool* (A: Array; position: SizeVector): BOOLEAN; 469 BEGIN 470 IF A IS BoolArray THEN RETURN A(BoolArray).b[Index(position^,A.dimension^)] 471 ELSE HALT (100) END 472 END GetBool; 473 474 PROCEDURE GetComplex* (A: Array; position: SizeVector): Complex; 475 VAR res: Complex; 476 BEGIN 477 IF A IS ComplexArray 478 THEN 479 NEW(res); 480 res.r := A(ComplexArray).r[Index(position^,A.dimension^)]; 481 res.i := A(ComplexArray).i[Index(position^,A.dimension^)]; 482 RETURN res 483 ELSE HALT (100) 484 END 485 END GetComplex; 486 487(* PROCEDURE Store* (R: Files.Rider; A: Array); 488 (* S3 specific ->eliminate from this module, into utility module *) 489 (** not yet implemented *) 490 BEGIN 491 (**) 492 END Store; 493 494 PROCEDURE Load* (R: Files.Rider; VAR A: Array); 495 (* S3 specific ->eliminate from this module, into utility module *) 496 (** not yet implemented *) 497 BEGIN 498 (**) 499 END Load; 500*) 501 PROCEDURE AllSInt1* (A: Array; f: PROCEDURE(s:SHORTINT): SHORTINT); 502 VAR n: LONGINT; 503 BEGIN 504 WITH A: SIntArray DO FOR n := 0 TO A.len-1 DO A.s[n] := f(A.s[n]) END 505 ELSE HALT(100) 506 END 507 END AllSInt1; 508 509 PROCEDURE AllSInt2* (A,B: Array; f: PROCEDURE(s1,s2:SHORTINT): SHORTINT); 510 VAR n: LONGINT; 511 BEGIN 512 WITH A: SIntArray DO 513 WITH B: SIntArray DO 514 FOR n := 0 TO A.len-1 DO A.s[n] := f(A.s[n],B.s[n]) END 515 ELSE HALT(100) 516 END 517 ELSE HALT(100) 518 END; 519 END AllSInt2; 520 521 PROCEDURE AllInt1* (A: Array; f: PROCEDURE(i:INTEGER): INTEGER); 522 VAR n: LONGINT; 523 BEGIN 524 WITH A: IntArray DO FOR n := 0 TO A.len-1 DO A.i[n] := f(A.i[n]) END 525 ELSE HALT(100) 526 END 527 END AllInt1; 528 529 PROCEDURE AllInt2* (A,B: Array; f: PROCEDURE(i1,i2:INTEGER): INTEGER); 530 VAR n: LONGINT; 531 BEGIN 532 WITH A: IntArray DO 533 WITH B: IntArray DO 534 FOR n := 0 TO A.len-1 DO A.i[n] := f(A.i[n],B.i[n]) END 535 ELSE HALT(100) 536 END; 537 ELSE HALT(100) 538 END 539 END AllInt2; 540 541 PROCEDURE AllLInt1* (A: Array; f: PROCEDURE(j:LONGINT): LONGINT); 542 VAR n: LONGINT; 543 BEGIN 544 WITH A: LIntArray DO FOR n := 0 TO A.len-1 DO A.j[n] := f(A.j[n]) END 545 ELSE HALT(100) 546 END 547 END AllLInt1; 548 549 PROCEDURE AllLInt2* (A,B: Array; f: PROCEDURE(j1,j2:LONGINT): LONGINT); 550 VAR n: LONGINT; 551 BEGIN 552 WITH A: LIntArray DO 553 WITH B: LIntArray DO 554 FOR n := 0 TO A.len-1 DO A.j[n] := f(A.j[n],B.j[n]) END 555 ELSE HALT(100) 556 END; 557 ELSE HALT(100) 558 END; 559 END AllLInt2; 560 561 PROCEDURE AllReal1* (A: Array; f: PROCEDURE(x:REAL): REAL); 562 VAR n: LONGINT; 563 BEGIN 564 WITH A: RealArray DO FOR n := 0 TO A.len-1 DO A.x[n] := f(A.x[n]) END 565 ELSE HALT(100) 566 END 567 END AllReal1; 568 569 PROCEDURE AllReal2* (A,B: Array; f: PROCEDURE(x1,x2:REAL): REAL); 570 VAR n: LONGINT; 571 BEGIN 572 WITH A: RealArray DO 573 WITH B: RealArray DO 574 FOR n := 0 TO A.len-1 DO A.x[n] := f(A.x[n],B.x[n]) END 575 ELSE HALT(100) 576 END; 577 ELSE HALT(100) 578 END 579 END AllReal2; 580 581 PROCEDURE AllLReal1* (A: Array; f: PROCEDURE(y:LONGREAL): LONGREAL); 582 VAR n: LONGINT; 583 BEGIN 584 WITH A: LRealArray DO FOR n := 0 TO A.len-1 DO A.y[n] := f(A.y[n]) END 585 ELSE HALT(100) 586 END 587 END AllLReal1; 588 589 PROCEDURE AllLReal2* (A,B: Array; f: PROCEDURE(y1,y2:LONGREAL): LONGREAL); 590 VAR n: LONGINT; 591 BEGIN 592 WITH A: LRealArray DO 593 WITH B: LRealArray DO 594 FOR n := 0 TO A.len-1 DO A.y[n] := f(A.y[n],B.y[n]) END 595 ELSE HALT(100) 596 END 597 ELSE HALT(100) 598 END 599 END AllLReal2; 600 601 PROCEDURE InvertSign (s: SHORTINT): SHORTINT; (* Test procedure for unary operations *) 602 BEGIN 603 RETURN -s 604 END InvertSign; 605 606 PROCEDURE Add (s1,s2: SHORTINT): SHORTINT; (* Test procedure for unary operations *) 607 BEGIN 608 RETURN s1+s2 609 END Add; 610 611 612PROCEDURE Test*; 613 (** Compares "Allxxx" procedure with conventional indexing scheme *) 614 VAR A1: Array; 615 A2: POINTER TO ARRAY OF ARRAY OF ARRAY OF ARRAY OF SHORTINT; 616 data: SIntPtr; 617 dim1: SizeVector; 618 i, starttime, endtime, a, b, c, d: LONGINT; 619 BEGIN 620 (* ALL ELEMENT OPERATIONS *) 621 Out.String("----------------------------------"); Out.Ln; 622 NEW(A1); 623 SizeVector4(dim1, 64, 32, 32, 32); 624 NEW(data, dim1[0]*dim1[1]*dim1[2]*dim1[3]); 625 InitSInt(A1, dim1, data, FALSE); 626 627 starttime := Input.Time(); 628 WITH A1: SIntArray DO 629 FOR i := 0 TO A1.len-1 DO A1.s[i] := InvertSign(A1.s[i]); END (* linear array access *) 630 END; 631 endtime := Input.Time(); 632 Out.String("ALL ELEMENT MONADIC OPERATION:"); Out.Ln; 633 Out.String("arbitrary array, linear access, invert sign:"); Out.String(" time: "); 634 Out.Int(endtime-starttime, 5); Out.String("ms for "); Out.Int(A1.len, 10); 635 Out.String(" elements"); Out.Ln; 636 637 starttime := Input.Time(); 638 AllSInt1(A1, InvertSign); (* monadic proc. using "All" procedure *) 639 endtime := Input.Time(); 640 641 Out.String("arbitrary array 'ALL procedure', invert sign:"); Out.String(" time: "); 642 Out.Int(endtime-starttime, 5); Out.String("ms for "); Out.Int(A1.len, 10); 643 Out.String(" elements"); Out.Ln; 644 NEW(A2, 64, 32, 32, 32); 645 646 starttime := Input.Time(); 647 FOR a := 0 TO LEN(A2^, 0)-1 DO (* monadic proc. using conventional indices *) 648 FOR b := 0 TO LEN(A2^, 1)-1 DO 649 FOR c := 0 TO LEN(A2^, 2)-1 DO 650 FOR d := 0 TO LEN(A2^, 3)-1 DO 651 A2[a, b, c, d] := InvertSign(A2[a, b, c, d]) 652 END 653 END 654 END 655 END; 656 endtime := Input.Time(); 657 658 Out.String("conventional indexed array invert sign:"); Out.String(" time: "); 659 Out.Int(endtime-starttime, 5); Out.String("ms for "); Out.Int(A1.len, 10); 660 Out.String(" elements"); Out.Ln; 661 Out.String("**********************************"); Out.Ln; 662 663 starttime := Input.Time(); 664 AllSInt2(A1, A1, Add); (* dyadic proc. using "All" procedure *) 665 endtime := Input.Time(); 666 667 Out.String("ALL ELEMENT DYADIC OPERATION:"); Out.Ln; 668 Out.String("arbitrary array ,'ALL procedure, addition:"); Out.String(" time: "); 669 Out.Int(endtime-starttime, 5); Out.String("ms for "); Out.Int(A1.len, 10); 670 Out.String(" elements"); Out.Ln; 671 672 starttime := Input.Time(); 673 FOR a := 0 TO LEN(A2^, 0)-1 DO (* dyadic proc. using conventional approach *) 674 FOR b := 0 TO LEN(A2^, 1)-1 DO 675 FOR c := 0 TO LEN(A2^, 2)-1 DO 676 FOR d := 0 TO LEN(A2^, 3)-1 DO 677 A2[a, b, c, d] := Add(A2[a, b, c, d], A2[a, b, c, d]) 678 END 679 END 680 END 681 END; 682 endtime := Input.Time(); 683 684 Out.String("conventional indexed array, addition:"); Out.String(" time: "); 685 Out.Int(endtime-starttime, 5); Out.String("ms for "); Out.Int(A1.len, 10); 686 Out.String(" elements"); Out.Ln; 687 Out.String("**********************************"); Out.Ln 688 END Test; 689 690(*PROCEDURE Test2*; (* insufficient registers with Intel *) 691VAR A, B: ARRAY 2, 2, 2, 2, 2, 2 OF INTEGER; 692 i, j, k, l, m, n, o, p, q, r: INTEGER; 693BEGIN 694 Out.String('Test2: ... '); 695 FOR i := 0 TO 1 DO 696 FOR j := 0 TO 1 DO 697 FOR k := 0 TO 1 DO 698 FOR l := 0 TO 1 DO 699 FOR m := 0 TO 1 DO 700 FOR n := 0 TO 1 DO 701 A[i, j, k, l, m, n] := B[i, j, k, l, m, n]+1 702 END 703 END 704 END 705 END 706 END 707 END 708 Out.String('done'); Out.Ln 709END Test2; *) 710 711(*PROCEDURE Test3*; (* insufficient registers with Intel *) 712VAR A, B: ARRAY 2,2,2,2,2,2,2,2,2,2 OF INTEGER; 713 i, j, k, l, m, n, o, p, q, r: INTEGER; 714BEGIN 715 Out.String('Test3: ... '); 716 FOR i := 0 TO 1 DO 717 FOR j := 0 TO 1 DO 718 FOR k := 0 TO 1 DO 719 FOR l := 0 TO 1 DO 720 FOR m := 0 TO 1 DO 721 FOR n := 0 TO 1 DO 722 FOR o := 0 TO 1 DO 723 FOR p := 0 TO 1 DO 724 FOR q := 0 TO 1 DO 725 FOR r := 0 TO 1 DO 726 A[i, j, k, l, m, n, o, p, q, r] := B[i, j, k, l, m, n, o, p, q, r]+1 727 END 728 END 729 END 730 END 731 END 732 END 733 END 734 END 735 END 736 END 737 Out.String('done'); Out.Ln 738END Test3; *) 739 740BEGIN 741END MultiArrays. 742 743MultiArrays.Test 744MultiArrays.Test2 745MultiArrays.Test3 746Compiler.Compile \xc MultiArrays.Mod ~ 747System.Free MultiArrays~ 748