123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173 |
- (* CAPO - Computational Analysis Platform for Oberon - by Alan Freed and Felix Friedrich. *)
- (* Version 1, Update 2 *)
- MODULE ArrayXdInt; (** AUTHOR "fof"; PURPOSE "Basic operations on an X-dimensional array of Integer"; *)
- (** any item containing the string "dbg" is for debugging purposes only and will be removed from this module,
- do NOT use *)
- IMPORT SYSTEM, NbrInt, ArrayXdBytes, Array1d := Array1dInt, dbgOut := KernelLog, DataErrors, DataIO;
- CONST
- generic* = 0; vector* = 1; matrix* = 2; cube* = 3; hcube* = 4;
- (** The version used when reading/writing an arbitrary dimensional array to file. *)
- VERSION* = 1;
- StrictBoundaryC* = 0; (* data beyond limit -> TRAP *)
- AbsorbingBoundaryC* = 1; (* data beyond limit = zero*)
- PeriodicBoundaryC* = 2; (* data[x] =data[x MOD LEN(data)], torus *)
- SymmetricOnBoundaryC* = 3; (* mirror boundaries, using border point once; W= reflection centered on point N *)
- SymmetricOffBoundaryC* = 4; (* mirror boundaries, using border point twice; reflection centered between point N and point N+1 *)
- AntisymmetricOnBoundaryC* = 5; (* like SymmetricOnBoundaryC but with additional change of sign if out of bounds *)
- AntisymmetricOffBoundaryC* = 6; (* like SymmetricOffBoundaryC but with additional change of sign if out of bounds *)
- TYPE
- Value* = Array1d.Value; Index* = LONGINT; Array1* = Array1d.Array;
- Array2* = POINTER TO ARRAY OF ARRAY OF Value;
- Array3* = POINTER TO ARRAY OF ARRAY OF ARRAY OF Value;
- Array4* = POINTER TO ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value;
- Map* = Array1d.Map;
- (** Class Array has been DataIO registered, and therefore, any instance of it can be made persistent
- by using the DataIO Reader and Writer, or more simply, by calling procedures Load and Store below. *)
- Array* = OBJECT (ArrayXdBytes.Array)
- VAR data-: Array1; (*! will probably be removed, do not use ! *)
- (** override *)
- PROCEDURE Allocate*( size: LONGINT; VAR adr: Index; VAR ptr: ANY );
- BEGIN
- NEW( data, size ); adr := ADDRESSOF( data[0] ); ptr := data;
- END Allocate;
- PROCEDURE GetInfo*( VAR elementsize: Index );
- BEGIN
- elementsize := SIZEOF( Value );
- END GetInfo;
- PROCEDURE AlikeX*( ): ArrayXdBytes.Array;
- VAR copy: Array;
- BEGIN
- NEW( copy, origin, len ); RETURN copy;
- END AlikeX;
- (** new *)
- (** Read and Write are for internal use only.
- Exporting them permits extensible, persistent, data types to be constructed. *)
- PROCEDURE Read*( R: DataIO.Reader );
- BEGIN {EXCLUSIVE}
- LoadXd( R )
- END Read;
- PROCEDURE Write*( W: DataIO.Writer );
- BEGIN
- StoreXd( W, TRUE )
- END Write;
- PROCEDURE Type*( ): SHORTINT;
- (* generic, vector, matrix, cube, hcube *)
- BEGIN
- IF dim < 5 THEN RETURN SHORT( SHORT( dim ) ) ELSE RETURN 0 END;
- END Type;
- PROCEDURE Get1*( x: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get1( SELF, x, v ); RETURN v;
- END Get1;
- PROCEDURE Set1*( x: Index; v: Value );
- BEGIN
- ArrayXdBytes.Set1( SELF, x, v );
- END Set1;
- PROCEDURE Get2*( x, y: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get2( SELF, x, y, v ); RETURN v;
- END Get2;
- PROCEDURE Set2*( x, y: Index; v: Value );
- BEGIN
- ArrayXdBytes.Set2( SELF, x, y, v );
- END Set2;
- PROCEDURE Get3*( x, y, z: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get3( SELF, x, y, z, v ); RETURN v;
- END Get3;
- PROCEDURE Set3*( x, y, z: Index; v: Value );
- BEGIN
- ArrayXdBytes.Set3( SELF, x, y, z, v );
- END Set3;
- PROCEDURE Get4*( x, y, z, t: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get4( SELF, x, y, z, t, v ); RETURN v;
- END Get4;
- PROCEDURE Set4*( x, y, z, t: Index; v: Value );
- BEGIN
- ArrayXdBytes.Set4( SELF, x, y, z, t, v );
- END Set4;
- PROCEDURE GetX*( VAR x: ARRAY OF Index; dim: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.GetX( SELF, x, dim, v ); RETURN v;
- END GetX;
- PROCEDURE SetX*( VAR x: ARRAY OF Index; dim: Index; v: Value );
- BEGIN
- ArrayXdBytes.SetX( SELF, x, dim, v );
- END SetX;
- (*** Get with boundary conditions *)
- (** absorbing: data beyond limit = zero *)
- PROCEDURE Get1BAbsorbing*( x: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) THEN ArrayXdBytes.Get1( SELF, x, v ); RETURN v ELSE RETURN 0 END;
- END Get1BAbsorbing;
- PROCEDURE Get2BAbsorbing*( x, y: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) THEN
- ArrayXdBytes.Get2( SELF, x, y, v ); RETURN v
- ELSE RETURN 0
- END;
- END Get2BAbsorbing;
- PROCEDURE Get3BAbsorbing*( x, y, z: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) THEN
- ArrayXdBytes.Get3( SELF, x, y, z, v ); RETURN v
- ELSE RETURN 0
- END;
- END Get3BAbsorbing;
- PROCEDURE Get4BAbsorbing*( x, y, z, t: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) &
- ArrayXdBytes.InBounds( o3, l3, t ) THEN
- ArrayXdBytes.Get4( SELF, x, y, z, t, v ); RETURN v
- ELSE RETURN 0
- END;
- END Get4BAbsorbing;
- PROCEDURE GetXBAbsorbing*( b: ARRAY OF Index; dim: Index ): Value;
- VAR v: Value; i: Index;
- BEGIN
- i := 0;
- WHILE (i < dim) DO
- IF ~ArrayXdBytes.InBounds( origin[i], len[i], b[i] ) THEN RETURN 0 END;
- INC( i );
- END;
- ArrayXdBytes.GetX( SELF, b, dim, v ); RETURN v
- END GetXBAbsorbing;
- (** periodic: data[x] =data[x MOD LEN(data)] *)
- PROCEDURE Get1BPeriodic*( x: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get1( SELF, ArrayXdBytes.PeriodicBounds( o0, l0, x ), v ); RETURN v
- END Get1BPeriodic;
- PROCEDURE Get2BPeriodic*( x, y: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get2( SELF, ArrayXdBytes.PeriodicBounds( o0, l0, x ), ArrayXdBytes.PeriodicBounds( o1, l1, y ), v );
- RETURN v
- END Get2BPeriodic;
- PROCEDURE Get3BPeriodic*( x, y, z: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get3( SELF, ArrayXdBytes.PeriodicBounds( o0, l0, x ), ArrayXdBytes.PeriodicBounds( o1, l1, y ),
- ArrayXdBytes.PeriodicBounds( o2, l2, z ), v );
- RETURN v
- END Get3BPeriodic;
- PROCEDURE Get4BPeriodic*( x, y, z, t: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get4( SELF, ArrayXdBytes.PeriodicBounds( o0, l0, x ), ArrayXdBytes.PeriodicBounds( o1, l1, y ),
- ArrayXdBytes.PeriodicBounds( o2, l2, z ), ArrayXdBytes.PeriodicBounds( o3, l3, z ), v );
- RETURN v
- END Get4BPeriodic;
- PROCEDURE GetXBPeriodic*( b: ARRAY OF Index; dim: Index ): Value;
- VAR v: Value; i: Index;
- BEGIN
- i := 0;
- WHILE (i < dim) DO b[i] := ArrayXdBytes.PeriodicBounds( origin[i], len[i], b[i] ); INC( i ) END;
- ArrayXdBytes.GetX( SELF, b, dim, v ); RETURN v
- END GetXBPeriodic;
- (** mirror boundaries, using border point twice; reflection centered between point N and point N+1 *)
- PROCEDURE Get1BSymmetricOffB*( x: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get1( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), v ); RETURN v
- END Get1BSymmetricOffB;
- PROCEDURE Get2BSymmetricOffB*( x, y: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get2( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ), v ); RETURN v
- END Get2BSymmetricOffB;
- PROCEDURE Get3BSymmetricOffB*( x, y, z: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get3( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ),
- ArrayXdBytes.MirrorOffB( o2, l2, z ), v );
- RETURN v
- END Get3BSymmetricOffB;
- PROCEDURE Get4BSymmetricOffB*( x, y, z, t: Index ): Value;
- VAR v: Value;
- BEGIN
- ArrayXdBytes.Get4( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ),
- ArrayXdBytes.MirrorOffB( o2, l2, z ), ArrayXdBytes.MirrorOffB( o3, l3, z ), v );
- RETURN v
- END Get4BSymmetricOffB;
- PROCEDURE GetXBSymmetricOffB*( b: ARRAY OF Index; dim: Index ): Value;
- VAR v: Value; i: Index;
- BEGIN
- i := 0;
- WHILE (i < dim) DO b[i] := ArrayXdBytes.MirrorOffB( origin[i], len[i], b[i] ); INC( i ) END;
- ArrayXdBytes.GetX( SELF, b, dim, v ); RETURN v
- END GetXBSymmetricOffB;
- (** mirror boundaries, using border point once; reflection centered on point N*)
- PROCEDURE Get1BSymmetricOnB*( x: Index ): Value;
- VAR v: Value;
- BEGIN
- x := ArrayXdBytes.MirrorOnB( o0, l0, x ); ArrayXdBytes.Get1( SELF, x, v ); RETURN v
- END Get1BSymmetricOnB;
- PROCEDURE Get2BSymmetricOnB*( x, y: Index ): Value;
- VAR v: Value;
- BEGIN
- x := ArrayXdBytes.MirrorOnB( o0, l0, x ); y := ArrayXdBytes.MirrorOnB( o1, l1, y );
- ArrayXdBytes.Get2( SELF, x, y, v ); RETURN v
- END Get2BSymmetricOnB;
- PROCEDURE Get3BSymmetricOnB*( x, y, z: Index ): Value;
- VAR v: Value;
- BEGIN
- x := ArrayXdBytes.MirrorOnB( o0, l0, x ); y := ArrayXdBytes.MirrorOnB( o1, l1, y );
- z := ArrayXdBytes.MirrorOnB( o2, l2, z ); ArrayXdBytes.Get3( SELF, x, y, z, v ); RETURN v
- END Get3BSymmetricOnB;
- PROCEDURE Get4BSymmetricOnB*( x, y, z, t: Index ): Value;
- VAR v: Value;
- BEGIN
- x := ArrayXdBytes.MirrorOnB( o0, l0, x ); y := ArrayXdBytes.MirrorOnB( o1, l1, y );
- z := ArrayXdBytes.MirrorOnB( o2, l2, z ); t := ArrayXdBytes.MirrorOnB( o3, l3, z );
- ArrayXdBytes.Get4( SELF, x, y, z, t, v ); RETURN v
- END Get4BSymmetricOnB;
- PROCEDURE GetXBSymmetricOnB*( b: ARRAY OF Index; dim: Index ): Value;
- VAR v: Value; i: Index;
- BEGIN
- i := 0;
- WHILE (i < dim) DO b[i] := ArrayXdBytes.MirrorOnB( origin[i], len[i], b[i] ); INC( i ) END;
- ArrayXdBytes.GetX( SELF, b, dim, v ); RETURN v
- END GetXBSymmetricOnB;
- (* like SymmetricOffB but with change of sign if not in range *)
- PROCEDURE Get1BAntisymmetricOffB*( x: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) THEN ArrayXdBytes.Get1( SELF, x, v ); RETURN v
- ELSE ArrayXdBytes.Get1( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), v ); RETURN -v;
- END;
- END Get1BAntisymmetricOffB;
- PROCEDURE Get2BAntisymmetricOffB*( x, y: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) THEN
- ArrayXdBytes.Get2( SELF, x, y, v ); RETURN v
- ELSE
- ArrayXdBytes.Get2( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ), v ); RETURN -v
- END;
- END Get2BAntisymmetricOffB;
- PROCEDURE Get3BAntisymmetricOffB*( x, y, z: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) THEN
- ArrayXdBytes.Get3( SELF, x, y, z, v ); RETURN v
- ELSE
- ArrayXdBytes.Get3( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ),
- ArrayXdBytes.MirrorOffB( o2, l2, z ), v );
- RETURN -v
- END;
- END Get3BAntisymmetricOffB;
- PROCEDURE Get4BAntisymmetricOffB*( x, y, z, t: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) &
- ArrayXdBytes.InBounds( o3, l3, t ) THEN
- ArrayXdBytes.Get4( SELF, x, y, z, t, v ); RETURN v
- ELSE
- ArrayXdBytes.Get4( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ),
- ArrayXdBytes.MirrorOffB( o2, l2, z ), ArrayXdBytes.MirrorOffB( o3, l3, t ), v );
- RETURN -v
- END;
- END Get4BAntisymmetricOffB;
- PROCEDURE GetXBAntisymmetricOffB*( b: ARRAY OF Index; dim: Index ): Value;
- VAR v: Value; i: Index; inv: BOOLEAN;
- BEGIN
- i := 0; inv := FALSE;
- WHILE (i < dim) DO
- inv := inv OR (~ArrayXdBytes.InBounds( origin[i], len[i], b[i] ));
- b[i] := ArrayXdBytes.MirrorOffB( origin[i], len[i], b[i] ); INC( i );
- END;
- ArrayXdBytes.GetX( SELF, b, dim, v );
- IF inv THEN RETURN -v ELSE RETURN v END;
- END GetXBAntisymmetricOffB;
- (** like SymmetricOnB but with change of sign if not in range *)
- PROCEDURE Get1BAntisymmetricOnB*( x: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) THEN ArrayXdBytes.Get1( SELF, x, v ); RETURN v
- ELSE ArrayXdBytes.Get1( SELF, ArrayXdBytes.MirrorOnB( o0, l0, x ), v ); RETURN -v;
- END;
- END Get1BAntisymmetricOnB;
- PROCEDURE Get2BAntisymmetricOnB*( x, y: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) THEN
- ArrayXdBytes.Get2( SELF, x, y, v ); RETURN v
- ELSE
- ArrayXdBytes.Get2( SELF, ArrayXdBytes.MirrorOnB( o0, l0, x ), ArrayXdBytes.MirrorOnB( o1, l1, y ), v ); RETURN -v
- END;
- END Get2BAntisymmetricOnB;
- PROCEDURE Get3BAntisymmetricOnB*( x, y, z: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) THEN
- ArrayXdBytes.Get3( SELF, x, y, z, v ); RETURN v
- ELSE
- ArrayXdBytes.Get3( SELF, ArrayXdBytes.MirrorOnB( o0, l0, x ), ArrayXdBytes.MirrorOnB( o1, l1, y ),
- ArrayXdBytes.MirrorOnB( o2, l2, z ), v );
- RETURN -v
- END;
- END Get3BAntisymmetricOnB;
- PROCEDURE Get4BAntisymmetricOnB*( x, y, z, t: Index ): Value;
- VAR v: Value;
- BEGIN
- IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) &
- ArrayXdBytes.InBounds( o3, l3, t ) THEN
- ArrayXdBytes.Get4( SELF, x, y, z, t, v ); RETURN v
- ELSE
- ArrayXdBytes.Get4( SELF, ArrayXdBytes.MirrorOnB( o0, l0, x ), ArrayXdBytes.MirrorOnB( o1, l1, y ),
- ArrayXdBytes.MirrorOnB( o2, l2, z ), ArrayXdBytes.MirrorOnB( o3, l3, t ), v );
- RETURN -v
- END;
- END Get4BAntisymmetricOnB;
- PROCEDURE GetXBAntisymmetricOnB*( b: ARRAY OF Index; dim: Index ): Value;
- VAR v: Value; i: Index; inv: BOOLEAN;
- BEGIN
- i := 0; inv := FALSE;
- WHILE (i < dim) DO
- inv := inv OR (~ArrayXdBytes.InBounds( origin[i], len[i], b[i] ));
- b[i] := ArrayXdBytes.MirrorOnB( origin[i], len[i], b[i] ); INC( i );
- END;
- ArrayXdBytes.GetX( SELF, b, dim, v );
- IF inv THEN RETURN -v ELSE RETURN v END;
- END GetXBAntisymmetricOnB;
- (** copy using the current boundary condition SELF.bc*)
- PROCEDURE CopyToArray*( dest: Array; srcpos, srclen, destpos, destlen: ArrayXdBytes.IndexArray );
- BEGIN
- CopyArrayToArrayPartB( SELF, dest, bc, srcpos, srclen, destpos, destlen );
- END CopyToArray;
- (** apply map m to all entries, dimension ordering is not necessarily preserved! *)
- PROCEDURE MapAll*( m: Array1d.Map );
- BEGIN
- IF m # NIL THEN Array1d.ApplyMap( m, data^, 0, LEN( data ) ); ELSE DataErrors.Error( "A NIL mapping function was supplied." ) END
- END MapAll;
- PROCEDURE Negate*;
- BEGIN {EXCLUSIVE}
- Array1d.Negate( data^, 0, LEN( data ) );
- (*
- FOR i := 0 TO len - 1 DO vec[i] := -vec[i] END
- *)
- END Negate;
- (** arr := arr+x *)
- PROCEDURE Add*( x: Array );
- BEGIN
- IF x # NIL THEN
- IF LEN( data ) = LEN( x.data ) THEN
- BEGIN {EXCLUSIVE}
- (*FOR i := 0 TO len - 1 DO vec[i] := vec[i] - x.vec[i] END*)
- Array1d.AddAA( data^, x.data^, data^, 0, len[0] );
- END
- ELSE DataErrors.Error( "Lengths of the two arrays were not equal." )
- END
- ELSE DataErrors.Error( "The supplied array to be subtracted was NIL." )
- END
- END Add;
- (** arr := arr-x *)
- PROCEDURE Subtract*( x: Array );
- BEGIN
- IF x # NIL THEN
- IF LEN( data ) = LEN( x.data ) THEN
- BEGIN {EXCLUSIVE}
- (*FOR i := 0 TO len - 1 DO vec[i] := vec[i] - x.vec[i] END*)
- Array1d.SubtractAA( data^, x.data^, data^, 0, len[0] );
- END
- ELSE DataErrors.Error( "Lengths of the two arrays were not equal." )
- END
- ELSE DataErrors.Error( "The supplied array to be subtracted was NIL." )
- END
- END Subtract;
- (* arr[i] := a*arr[i] forall i*)
- PROCEDURE Multiply*( a: Value );
- VAR i: Index;
- BEGIN {EXCLUSIVE}
- FOR i := 0 TO LEN( data ) - 1 DO data[i] := a * data[i] END
- END Multiply;
- (** arr[i] :=arr[i] / a forall i *)
- PROCEDURE Divide*( a: Value );
- VAR i: Index;
- BEGIN
- IF a # 0 THEN
- BEGIN {EXCLUSIVE}
- FOR i := 0 TO LEN( data ) - 1 DO data[i] := data[i] DIV a; END
- END;
- ELSE DataErrors.Error( "Division by zero." )
- END
- END Divide;
- (** arr[i] :=arr[i] MOD a forall i *)
- PROCEDURE Modulus*( a: Value );
- VAR i: Index;
- BEGIN
- IF a # 0 THEN
- BEGIN {EXCLUSIVE}
- FOR i := 0 TO LEN( data ) - 1 DO data[i] := data[i] MOD a END
- END
- ELSE DataErrors.Error( "Division by zero." )
- END
- END Modulus;
- PROCEDURE dbgWrite*;
- VAR x, y, z: LONGINT;
- BEGIN
- IF Type() = vector THEN
- dbgOut.String( "|" );
- FOR x := origin[0] TO origin[0] + len[0] - 1 DO dbgOut.Int( Get1( x ), 12 ); dbgOut.String( "|" ); END;
- dbgOut.Ln;
- ELSIF Type() = matrix THEN
- FOR y := origin[1] TO origin[1] + len[1] - 1 DO
- dbgOut.String( "|" );
- FOR x := origin[0] TO origin[0] + len[0] - 1 DO dbgOut.Int( Get2( x, y ), 12 ); dbgOut.String( "|" ); END;
- dbgOut.Ln;
- END;
- ELSIF Type() = cube THEN
- FOR z := origin[2] TO origin[2] + len[2] - 1 DO
- dbgOut.String( "z=" ); dbgOut.Int( z, 0 ); dbgOut.Ln;
- FOR y := origin[1] TO origin[1] + len[1] - 1 DO
- dbgOut.String( "|" );
- FOR x := origin[0] TO origin[0] + len[0] - 1 DO dbgOut.Int( Get3( x, y, z ), 12 ); dbgOut.String( "|" ); END;
- dbgOut.Ln;
- END;
- dbgOut.Ln;
- END;
- END;
- END dbgWrite;
- END Array;
- PROCEDURE New1d*( ox, w: Index ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, ArrayXdBytes.Array1( ox ), ArrayXdBytes.Array1( w ) ); RETURN res;
- END New1d;
- PROCEDURE New2d*( ox, w, oy, h: Index ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, ArrayXdBytes.Array2( ox, oy ), ArrayXdBytes.Array2( w, h ) ); RETURN res;
- END New2d;
- PROCEDURE New3d*( ox, w, oy, h, oz, d: Index ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, ArrayXdBytes.Array3( ox, oy, oz ), ArrayXdBytes.Array3( w, h, d ) ); RETURN res;
- END New3d;
- PROCEDURE New4d*( ox, w, oy, h, oz, d, ot, dt: Index ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, ArrayXdBytes.Array4( ox, oy, oz, ot ), ArrayXdBytes.Array4( w, h, d, dt ) ); RETURN res;
- END New4d;
- PROCEDURE CopyVecToVec*( src, dest: Array; srcx, destx, len: Index );
- BEGIN
- IF (src.dim # 1) OR (dest.dim # 1) THEN HALT( 1001 ) END;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index1( srcx ), ArrayXdBytes.Index1( len ),
- ArrayXdBytes.Index1( destx ), ArrayXdBytes.Index1( len ) );
- END CopyVecToVec;
- PROCEDURE CopyMtxToVec*( src, dest: Array; dim: Index; srcx, srcy, destx, len: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 2) OR (dest.dim # 1) THEN HALT( 1002 ) END;
- slen := ArrayXdBytes.Index2( 1, 1 ); slen[dim] := len;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index2( srcx, srcy ), slen,
- ArrayXdBytes.Index1( destx ), ArrayXdBytes.Index1( len ) );
- END CopyMtxToVec;
- PROCEDURE CopyVecToMtx*( src, dest: Array; dim: Index; srcx, destx, desty, len: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 1) OR (dest.dim # 2) THEN HALT( 1002 ) END;
- slen := ArrayXdBytes.Index2( 1, 1 ); slen[dim] := len;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index1( srcx ), ArrayXdBytes.Index1( len ),
- ArrayXdBytes.Index2( destx, desty ), slen );
- END CopyVecToMtx;
- PROCEDURE CopyCubeToVec*( src, dest: Array; dim: Index; srcx, srcy, srcz, destx, len: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 3) OR (dest.dim # 1) THEN HALT( 1003 ) END;
- slen := ArrayXdBytes.Index3( 1, 1, 1 ); slen[dim] := len;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index3( srcx, srcy, srcz ), slen,
- ArrayXdBytes.Index1( destx ), ArrayXdBytes.Index1( len ) );
- END CopyCubeToVec;
- PROCEDURE CopyVecToCube*( src, dest: Array; dim: Index; srcx, destx, desty, destz, len: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 1) OR (dest.dim # 3) THEN HALT( 1002 ) END;
- slen := ArrayXdBytes.Index3( 1, 1, 1 ); slen[dim] := len;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index1( srcx ), ArrayXdBytes.Index1( len ),
- ArrayXdBytes.Index3( destx, desty, destz ), slen );
- END CopyVecToCube;
- PROCEDURE CopyHCubeToVec*( src, dest: Array; dim: Index; srcx, srcy, srcz, srct, destx, len: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 4) OR (dest.dim # 1) THEN HALT( 1004 ) END;
- slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dim] := len;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ), slen,
- ArrayXdBytes.Index1( destx ), ArrayXdBytes.Index1( len ) );
- END CopyHCubeToVec;
- PROCEDURE CopyVecToHCube*( src, dest: Array; dim: Index; srcx, destx, desty, destz, destt, len: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 1) OR (dest.dim # 4) THEN HALT( 1002 ) END;
- slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dim] := len;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index1( srcx ), ArrayXdBytes.Index1( len ),
- ArrayXdBytes.Index4( destx, desty, destz, destt ), slen );
- END CopyVecToHCube;
- PROCEDURE CopyMtxToMtx*( src, dest: Array; srcx, srcy, destx, desty, lenx, leny: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 2) OR (dest.dim # 2) THEN HALT( 1005 ) END;
- slen := ArrayXdBytes.Index2( lenx, leny );
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index2( srcx, srcy ), slen,
- ArrayXdBytes.Index2( destx, desty ), slen );
- END CopyMtxToMtx;
- PROCEDURE CopyCubeToMtx*( src, dest: Array; dimx, dimy: Index; srcx, srcy, srcz, destx, desty, lenx, leny: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 3) OR (dest.dim # 2) THEN HALT( 1005 ) END;
- slen := ArrayXdBytes.Index3( 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index3( srcx, srcy, srcz ), slen,
- ArrayXdBytes.Index2( destx, desty ), ArrayXdBytes.Index2( lenx, leny ) );
- END CopyCubeToMtx;
- PROCEDURE CopyMtxToCube*( src, dest: Array; dimx, dimy: Index; srcx, srcy, destx, desty, destz, lenx, leny: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 2) OR (dest.dim # 3) THEN HALT( 1005 ) END;
- slen := ArrayXdBytes.Index3( 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index2( srcx, srcy ), ArrayXdBytes.Index2( lenx, leny ),
- ArrayXdBytes.Index3( destx, desty, destz ), slen );
- END CopyMtxToCube;
- PROCEDURE CopyHCubeToMtx*( src, dest: Array; dimx, dimy: Index; srcx, srcy, srcz, srct, destx, desty, lenx, leny: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 4) OR (dest.dim # 2) THEN HALT( 1005 ) END;
- slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ), slen,
- ArrayXdBytes.Index2( destx, desty ), ArrayXdBytes.Index2( lenx, leny ) );
- END CopyHCubeToMtx;
- PROCEDURE CopyMtxToHCube*( src, dest: Array; dimx, dimy: Index;
- srcx, srcy, destx, desty, destz, destt, lenx, leny: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 2) OR (dest.dim # 4) THEN HALT( 1005 ) END;
- slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index2( srcx, srcy ), ArrayXdBytes.Index2( lenx, leny ),
- ArrayXdBytes.Index4( destx, desty, destz, destt ), slen );
- END CopyMtxToHCube;
- PROCEDURE CopyCubeToCube*( src, dest: Array; srcx, srcy, srcz, destx, desty, destz, lenx, leny, lenz: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 3) OR (dest.dim # 3) THEN HALT( 1005 ) END;
- slen := ArrayXdBytes.Index3( lenx, leny, lenz );
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index3( srcx, srcy, srcz ), slen,
- ArrayXdBytes.Index3( destx, desty, destz ), slen );
- END CopyCubeToCube;
- PROCEDURE CopyHCubeToCube*( src, dest: Array; dimx, dimy, dimz: Index;
- srcx, srcy, srcz, srct, destx, desty, destz, lenx, leny, lenz: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 4) OR (dest.dim # 3) THEN HALT( 1005 ) END;
- slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny; slen[dimz] := lenz;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ), slen,
- ArrayXdBytes.Index3( destx, desty, destz ),
- ArrayXdBytes.Index3( lenx, leny, lenz ) );
- END CopyHCubeToCube;
- PROCEDURE CopyCubeToHCube*( src, dest: Array; dimx, dimy, dimz: Index;
- srcx, srcy, srcz, destx, desty, destz, destt, lenx, leny, lenz: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 3) OR (dest.dim # 4) THEN HALT( 1005 ) END;
- slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny; slen[dimz] := lenz;
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index3( srcx, srcy, srcz ),
- ArrayXdBytes.Index3( lenx, leny, lenz ),
- ArrayXdBytes.Index4( destx, desty, destz, destt ), slen );
- END CopyCubeToHCube;
- PROCEDURE CopyHCubeToHCube*( src, dest: Array;
- srcx, srcy, srcz, srct, destx, desty, destz, destt, lenx, leny, lenz, lent: Index );
- VAR slen: ArrayXdBytes.IndexArray;
- BEGIN
- IF (src.dim # 4) OR (dest.dim # 4) THEN HALT( 1005 ) END;
- slen := ArrayXdBytes.Index4( lenx, leny, lenz, lent );
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ), slen,
- ArrayXdBytes.Index4( destx, desty, destz, destt ), slen );
- END CopyHCubeToHCube;
- PROCEDURE CopyArrayToVec*( VAR src: ARRAY OF Value; dest: Array; srcx, destx, len: Index );
- BEGIN
- IF dest.dim # 1 THEN HALT( 1005 ) END;
- ArrayXdBytes.CheckLEQ( 0, srcx ); ArrayXdBytes.CheckLE( srcx + len, LEN( src ) );
- ArrayXdBytes.CopyMemoryToArrayPart( ADDRESSOF( src[srcx] ), dest, len, ArrayXdBytes.Index1( destx ),
- ArrayXdBytes.Index1( len ) );
- END CopyArrayToVec;
- PROCEDURE CopyVecToArray*( src: Array; VAR dest: ARRAY OF Value; srcx, destx, len: Index );
- BEGIN
- IF src.dim # 1 THEN HALT( 1005 ) END;
- ArrayXdBytes.CheckLEQ( 0, destx ); ArrayXdBytes.CheckLE( destx + len, LEN( dest ) );
- ArrayXdBytes.CopyArrayPartToMemory( src, ADDRESSOF( dest[destx] ), ArrayXdBytes.Index1( srcx ),
- ArrayXdBytes.Index1( len ), len );
- END CopyVecToArray;
- PROCEDURE CopyArrayToMtx*( VAR src: ARRAY OF ARRAY OF Value; dest: Array; srcx, srcy, destx, desty, lenx, leny: Index );
- VAR srcmem: ArrayXdBytes.ArrayMemoryStructure;
- BEGIN
- IF dest.dim # 2 THEN HALT( 1005 ) END;
- srcmem :=
- ArrayXdBytes.MakeMemoryStructure( 2, ArrayXdBytes.Index2( 0, 0 ), ArrayXdBytes.Index2( LEN( src, 1 ), LEN( src, 0 ) ),
- SIZEOF( Value ), ADDRESSOF( src[0, 0] ) );
- ArrayXdBytes.CopyArrayPartToArrayPart( srcmem, dest, ArrayXdBytes.Index2( srcx, srcy ),
- ArrayXdBytes.Index2( lenx, leny ), ArrayXdBytes.Index2( destx, desty ),
- ArrayXdBytes.Index2( lenx, leny ) );
- END CopyArrayToMtx;
- PROCEDURE CopyMtxToArray*( src: Array; VAR dest: ARRAY OF ARRAY OF Value; srcx, srcy, destx, desty, lenx, leny: Index );
- VAR destmem: ArrayXdBytes.ArrayMemoryStructure;
- BEGIN
- IF src.dim # 2 THEN HALT( 1005 ) END;
- destmem :=
- ArrayXdBytes.MakeMemoryStructure( 2, ArrayXdBytes.Index2( 0, 0 ), ArrayXdBytes.Index2( LEN( dest, 1 ), LEN( dest, 0 ) ),
- SIZEOF( Value ), ADDRESSOF( dest[0, 0] ) );
- ArrayXdBytes.CopyArrayPartToArrayPart( src, destmem, ArrayXdBytes.Index2( srcx, srcy ),
- ArrayXdBytes.Index2( lenx, leny ), ArrayXdBytes.Index2( destx, desty ),
- ArrayXdBytes.Index2( lenx, leny ) );
- END CopyMtxToArray;
- PROCEDURE CopyArrayToCube*( VAR src: ARRAY OF ARRAY OF ARRAY OF Value; dest: Array;
- srcx, srcy, srcz, destx, desty, destz, lenx, leny, lenz: Index );
- VAR srcmem: ArrayXdBytes.ArrayMemoryStructure;
- BEGIN
- IF dest.dim # 3 THEN HALT( 1005 ) END;
- srcmem :=
- ArrayXdBytes.MakeMemoryStructure( 3, ArrayXdBytes.Index3( 0, 0, 0 ),
- ArrayXdBytes.Index3( LEN( src, 2 ), LEN( src, 1 ), LEN( src, 0 ) ), SIZEOF( Value ),
- ADDRESSOF( src[0, 0, 0] ) );
- ArrayXdBytes.CopyArrayPartToArrayPart( srcmem, dest, ArrayXdBytes.Index3( srcx, srcy, srcz ),
- ArrayXdBytes.Index3( lenx, leny, lenz ),
- ArrayXdBytes.Index3( destx, desty, destz ),
- ArrayXdBytes.Index3( lenx, leny, lenz ) );
- END CopyArrayToCube;
- PROCEDURE CopyCubeToArray*( src: Array; VAR dest: ARRAY OF ARRAY OF ARRAY OF Value;
- srcx, srcy, srcz, destx, desty, destz, lenx, leny, lenz: Index );
- VAR destmem: ArrayXdBytes.ArrayMemoryStructure;
- BEGIN
- IF src.dim # 3 THEN HALT( 1005 ) END;
- destmem :=
- ArrayXdBytes.MakeMemoryStructure( 3, ArrayXdBytes.Index3( 0, 0, 0 ),
- ArrayXdBytes.Index3( LEN( dest, 2 ), LEN( dest, 1 ), LEN( dest, 0 ) ), SIZEOF( Value ),
- ADDRESSOF( dest[0, 0, 0] ) );
- ArrayXdBytes.CopyArrayPartToArrayPart( src, destmem, ArrayXdBytes.Index3( srcx, srcy, srcz ),
- ArrayXdBytes.Index3( lenx, leny, lenz ),
- ArrayXdBytes.Index3( destx, desty, destz ),
- ArrayXdBytes.Index3( lenx, leny, lenz ) );
- END CopyCubeToArray;
- PROCEDURE CopyArrayToHCube*( VAR src: ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value; dest: Array;
- srcx, srcy, srcz, srct, destx, desty, destz, destt, lenx, leny, lenz, lent: Index );
- VAR srcmem: ArrayXdBytes.ArrayMemoryStructure;
- BEGIN
- IF dest.dim # 4 THEN HALT( 1005 ) END;
- srcmem :=
- ArrayXdBytes.MakeMemoryStructure( 4, ArrayXdBytes.Index4( 0, 0, 0, 0 ),
- ArrayXdBytes.Index4( LEN( src, 3 ), LEN( src, 2 ), LEN( src, 1 ), LEN( src, 0 ) ), SIZEOF( Value ),
- ADDRESSOF( src[0, 0, 0] ) );
- ArrayXdBytes.CopyArrayPartToArrayPart( srcmem, dest, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ),
- ArrayXdBytes.Index4( lenx, leny, lenz, lent ),
- ArrayXdBytes.Index4( destx, desty, destz, destt ),
- ArrayXdBytes.Index4( lenx, leny, lenz, lent ) );
- END CopyArrayToHCube;
- PROCEDURE CopyHCubeToArray*( src: Array; VAR dest: ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value;
- srcx, srcy, srcz, srct, destx, desty, destz, destt, lenx, leny, lenz, lent: Index );
- VAR destmem: ArrayXdBytes.ArrayMemoryStructure;
- BEGIN
- IF src.dim # 4 THEN HALT( 1005 ) END;
- destmem :=
- ArrayXdBytes.MakeMemoryStructure( 4, ArrayXdBytes.Index4( 0, 0, 0, 0 ),
- ArrayXdBytes.Index4( LEN( dest, 3 ), LEN( dest, 2 ), LEN( dest, 1 ), LEN( dest, 0 ) ), SIZEOF( Value ),
- ADDRESSOF( dest[0, 0, 0] ) );
- ArrayXdBytes.CopyArrayPartToArrayPart( src, destmem, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ),
- ArrayXdBytes.Index4( lenx, leny, lenz, lent ),
- ArrayXdBytes.Index4( destx, desty, destz, destt ),
- ArrayXdBytes.Index4( lenx, leny, lenz, lent ) );
- END CopyHCubeToArray;
- PROCEDURE CopyArrayToArrayPartB*( src: Array; dest: ArrayXdBytes.ArrayMemoryStructure; boundaryCondition: SHORTINT;
- srcpos, srclen, destpos, destlen: ArrayXdBytes.IndexArray );
- VAR temp: ArrayXdBytes.ArrayMemoryStructure;
- spos, dpos, last, borigin, blen, srcposcut, srclencut, destoffset: ArrayXdBytes.IndexArray; i, dim: LONGINT;
- val: Value; temp2: Array; enumB: ArrayXdBytes.BoundaryEnum;
- Get: PROCEDURE {DELEGATE} ( x: ARRAY OF Index;
- dim: Index ): Value;
- noinbound: BOOLEAN; v: Value;
- (* for debugging
- PROCEDURE OutIndex( idx: ArrayXdBytes.IndexArray; name: ARRAY OF CHAR );
- VAR i: LONGINT;
- BEGIN
- dbgOut.String( name );
- FOR i := 0 TO LEN( idx ) - 1 DO dbgOut.Int( idx[i], 1 ); dbgOut.String( "," ); END;
- dbgOut.Ln;
- END OutIndex;
- *)
- PROCEDURE Same( a, b: ArrayXdBytes.IndexArray ): BOOLEAN;
- BEGIN
- IF LEN( a ) # LEN( b ) THEN RETURN FALSE END;
- FOR i := 0 TO LEN( a ) - 1 DO
- IF a[i] # b[i] THEN RETURN FALSE END;
- END;
- RETURN TRUE;
- END Same;
- BEGIN
- dim := src.dim;
- IF boundaryCondition = StrictBoundaryC THEN
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, srcpos, srclen, destpos, destlen ); (* checks are done there *)
- ELSE
- srcposcut := ArrayXdBytes.IndexCpy( srcpos ); srclencut := ArrayXdBytes.IndexCpy( srclen );
- NEW( enumB, src, srcposcut, srclencut );
- IF (Same( srcposcut, srcpos )) & (Same( srclencut, srclen )) THEN (* no boundaries *)
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, srcpos, srclen, destpos, destlen ); RETURN;
- ELSE
- CASE boundaryCondition OF
- PeriodicBoundaryC:
- Get := src.GetXBPeriodic;
- | SymmetricOnBoundaryC:
- Get := src.GetXBSymmetricOnB;
- | SymmetricOffBoundaryC:
- Get := src.GetXBSymmetricOffB;
- | AntisymmetricOnBoundaryC:
- Get := src.GetXBAntisymmetricOnB;
- | AntisymmetricOffBoundaryC:
- Get := src.GetXBAntisymmetricOffB;
- | AbsorbingBoundaryC:
- ArrayXdBytes.FillArrayPart( dest, destpos, destlen, val ); (* fill with 0 first *)
- Get := NIL;
- END;
- NEW( destoffset, dim ); noinbound := FALSE;
- IF Same( srclen, destlen ) THEN (* same geometry, direct copy to boundary rects can be used*)
- FOR i := 0 TO dim - 1 DO
- destoffset[i] := destpos[i] + srcposcut[i] - srcpos[i];
- IF srclencut[i] = 0 THEN noinbound := TRUE END;
- END;
- IF ~noinbound THEN
- ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, srcposcut, srclencut, destoffset, srclencut );
- END;
- FOR i := 0 TO dim - 1 DO destoffset[i] := destpos[i] - srcpos[i]; END;
- temp := dest;
- ELSE (* not the same geometry, direct copy using rectangles cannot be used *)
- NEW( temp2, srcpos, srclen ); temp := temp2;
- FOR i := 0 TO dim - 1 DO
- destoffset[i] := 0;
- IF srclencut[i] = 0 THEN noinbound := TRUE END;
- END;
- IF ~noinbound THEN
- ArrayXdBytes.CopyArrayPartToArrayPart( src, temp, srcposcut, srclencut, srcposcut, srclencut );
- END;
- END;
- IF Get # NIL THEN
- NEW( spos, dim ); NEW( dpos, dim ); NEW( last, dim );
- WHILE (enumB.Get( borigin, blen )) DO (* enumeration of rects describing the region out of range *)
- FOR i := 0 TO dim - 1 DO spos[i] := borigin[i]; last[i] := spos[i] + blen[i]; dpos[i] := spos[i] + destoffset[i] END;
- REPEAT
- v := Get( spos^, dim );
- SYSTEM.MOVE( ADDRESSOF( v ), ArrayXdBytes.AdrX( temp, dpos^, dim ), SIZEOF( Value ) ); (* optimize adress handling of destination, compute here ! *)
- (*temp.SetX( dpos^, dim, Get( spos^, dim ) );*) i := 0; INC( spos[i] ); INC( dpos[i] );
- WHILE (i < dim - 1) & (spos[i] = last[i]) DO
- spos[i] := borigin[i]; dpos[i] := destoffset[i] + borigin[i]; INC( i ); INC( spos[i] ); INC( dpos[i] );
- END;
- UNTIL spos[i] = last[i];
- END;
- END;
- IF temp # dest THEN ArrayXdBytes.CopyArrayPartToArrayPart( temp, dest, srcpos, srclen, destpos, destlen );
- END;
- END;
- END;
- END CopyArrayToArrayPartB;
- OPERATOR ":="*( VAR l: Array; VAR r: ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value );
- BEGIN
- (* IF r = NIL THEN l := NIL; RETURN END; *)
- IF l = NIL THEN l := New4d( 0, LEN( r, 3 ), 0, LEN( r, 2 ), 0, LEN( r, 1 ), 0, LEN( r, 0 ) );
- ELSE l.NewRangeX( ArrayXdBytes.Array4( 0, 0, 0, 0 ), ArrayXdBytes.Array4( LEN( r, 3 ), LEN( r, 2 ), LEN( r, 1 ), LEN( r, 0 ) ), FALSE )
- END;
- ArrayXdBytes.CopyMemoryToArray( ADDRESSOF( r[0, 0, 0, 0] ), l, LEN( r, 0 ) * LEN( r, 1 ) * LEN( r, 2 ) * LEN( r, 3 ) );
- END ":=";
- OPERATOR ":="*( VAR l: Array; VAR r: ARRAY OF ARRAY OF ARRAY OF Value );
- BEGIN
- (* IF r = NIL THEN l := NIL; RETURN END; *)
- IF l = NIL THEN l := New3d( 0, LEN( r, 2 ), 0, LEN( r, 1 ), 0, LEN( r, 0 ) );
- ELSE l.NewRangeX( ArrayXdBytes.Array3( 0, 0, 0 ), ArrayXdBytes.Array3( LEN( r, 2 ), LEN( r, 1 ), LEN( r, 0 ) ), FALSE );
- END;
- ArrayXdBytes.CopyMemoryToArray( ADDRESSOF( r[0, 0, 0] ), l, LEN( r, 0 ) * LEN( r, 1 ) * LEN( r, 2 ) );
- END ":=";
- (*
- OPERATOR ":="( VAR l: Array; VAR r: ARRAY OF ARRAY OF Value );
- BEGIN
- (* IF r = NIL THEN l := NIL; RETURN END; *)
- IF l = NIL THEN l := New2d( 0, LEN( r, 1 ), 0, LEN( r, 0 ) )
- ELSE l.NewRangeX( ArrayXdBytes.Array2( 0, 0 ), ArrayXdBytes.Array2( LEN( r, 1 ), LEN( r, 0 ) ), FALSE );
- END;
- ArrayXdBytes.CopyMemoryToArray( ADDRESSOF( r[0, 0] ), l, LEN( r, 0 ) * LEN( r, 1 ) );
- END ":=";
- OPERATOR ":="( VAR l: Array; VAR r: ARRAY OF Value );
- BEGIN
- (* IF r = NIL THEN l := NIL; RETURN END; *)
- IF l = NIL THEN l := New1d( 0, LEN( r, 0 ) )
- ELSE l.NewRangeX( ArrayXdBytes.Array1( 0 ), ArrayXdBytes.Array1( LEN( r, 0 ) ), FALSE );
- END;
- ArrayXdBytes.CopyMemoryToArray( ADDRESSOF( r[0] ), l, LEN( r, 0 ) );
- END ":=";
- *)
- (***!never do this : *
- OPERATOR ":="( VAR l: Array; r: Vector );
- BEGIN
- IF r = NIL THEN l := NIL; RETURN END;
- IF l = NIL THEN NEW( l, r.origin^, r.len^ ) ELSE l.NewRangeX( r.origin^, r.len^, TRUE ); END;
- r.CopyElements( r.origin^, r.len^, l, l.origin^, l.len^ );
- END ":=";
- *)
- OPERATOR ":="*( VAR l: Array1; r: Array );
- BEGIN
- IF r = NIL THEN l := NIL; RETURN END;
- ArrayXdBytes.CheckEQ( 1, r.dim ); (*ArrayXdBytes.CheckEQ( r.origin[0], 0 ); *)
- IF (l = NIL ) OR (LEN( l ) # r.len[0]) THEN NEW( l, r.len[0] ); END;
- ArrayXdBytes.CopyArrayToMemory( r, ADDRESSOF( l[0] ), LEN( l, 0 ) );
- END ":=";
- OPERATOR ":="*( VAR l: Array2; r: Array );
- BEGIN
- IF r = NIL THEN l := NIL; RETURN END;
- ArrayXdBytes.CheckEQ( 2, r.dim ); (*ArrayXdBytes.CheckEQ( r.origin[0], 0 ); ArrayXdBytes.CheckEQ( r.origin[1], 0 ); *)
- IF (l = NIL ) OR (LEN( l, 1 ) # r.len[0]) OR (LEN( l, 0 ) # r.len[1]) THEN NEW( l, r.len[1], r.len[0] ); END;
- ArrayXdBytes.CopyArrayToMemory( r, ADDRESSOF( l[0, 0] ), LEN( l, 0 ) * LEN( l, 1 ) );
- END ":=";
- OPERATOR ":="*( VAR l: Array3; r: Array );
- BEGIN
- IF r = NIL THEN l := NIL; RETURN END;
- ArrayXdBytes.CheckEQ( 3, r.dim ); (*ArrayXdBytes.CheckEQ( r.origin[0], 0 ); ArrayXdBytes.CheckEQ( r.origin[1], 0 ); ArrayXdBytes.CheckEQ( r.origin[2], 0 ); *)
- IF (l = NIL ) OR (LEN( l, 2 ) # r.len[0]) OR (LEN( l, 1 ) # r.len[1]) OR (LEN( l, 0 ) # r.len[2]) THEN NEW( l, r.len[2], r.len[1], r.len[0] ); END;
- ArrayXdBytes.CopyArrayToMemory( r, ADDRESSOF( l[0, 0, 0] ), LEN( l, 0 ) * LEN( l, 1 ) * LEN( l, 2 ) );
- END ":=";
- (*
- OPERATOR ":="( VAR l: Array4; r: Array );
- BEGIN
- IF r = NIL THEN l := NIL; RETURN END;
- ArrayXdBytes.CheckEQ( 4, r.dim ); (*ArrayXdBytes.CheckEQ( r.origin[0], 0 ); ArrayXdBytes.CheckEQ( r.origin[1], 0 ); ArrayXdBytes.CheckEQ( r.origin[2], 0 );
- ArrayXdBytes.CheckEQ( r.origin[3], 0 ); *)
- IF (l = NIL ) OR (LEN( l, 3 ) # r.len[0]) OR (LEN( l, 2 ) # r.len[1]) OR (LEN( l, 1 ) # r.len[2]) OR (LEN( l, 0 ) # r.len[3]) THEN
- NEW( l, r.len[3], r.len[2], r.len[1], r.len[0] );
- END;
- ArrayXdBytes.CopyArrayToMemory( r, ADDRESSOF( l[0, 0, 0, 0] ), LEN( l, 0 ) * LEN( l, 1 ) * LEN( l, 2 ) * LEN( l, 3 ) );
- END ":=";
- *)
- PROCEDURE Fill*( l: Array; r: Value );
- BEGIN
- Array1d.Fill( r, l.data^, 0, LEN( l.data ) );
- END Fill;
- OPERATOR ":="*( VAR l: Array; r: Value );
- BEGIN
- IF l # NIL THEN Fill( l, r ) END;
- END ":=";
- PROCEDURE Add*( l, r, res: Array );
- BEGIN
- ArrayXdBytes.CheckEqDimensions( l, r ); Array1d.AddAA( l.data^, r.data^, res.data^, 0, LEN( res.data ) );
- END Add;
- OPERATOR "+"*( l, r: Array ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, l.origin, l.len ); Add( l, r, res ); RETURN res;
- END "+";
- PROCEDURE Sub*( l, r, res: Array );
- BEGIN
- ArrayXdBytes.CheckEqDimensions( l, r ); Array1d.SubtractAA( l.data^, r.data^, res.data^, 0, LEN( res.data ) );
- END Sub;
- OPERATOR "-"*( l, r: Array ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, l.origin, l.len); Sub( l, r, res ); RETURN res;
- END "-";
- PROCEDURE Mul*( l, r, res: Array );
- BEGIN
- ArrayXdBytes.CheckEqDimensions( l, r ); Array1d.MultAA( l.data^, r.data^, res.data^, 0, LEN( res.data ) );
- END Mul;
- PROCEDURE Div*( l, r, res: Array );
- BEGIN
- ArrayXdBytes.CheckEqDimensions( l, r ); Array1d.DivAA( l.data^, r.data^, res.data^, 0, LEN( res.data ) );
- END Div;
- PROCEDURE Mod*( l, r, res: Array );
- BEGIN
- ArrayXdBytes.CheckEqDimensions( l, r ); Array1d.ModAA( l.data^, r.data^, res.data^, 0, LEN( res.data ) );
- END Mod;
- PROCEDURE AddAV*( l: Array; r: Value; res: Array );
- BEGIN
- Array1d.AddAV( l.data^, r, res.data^, 0, LEN( res.data ) );
- END AddAV;
- OPERATOR "+"( l: Array; r: Value ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, l.origin, l.len ); AddAV( l, r, res ); RETURN res;
- END "+";
- OPERATOR "+"( l: Value; r: Array ): Array;
- BEGIN
- RETURN r + l
- END "+";
- PROCEDURE MulAV*( l: Array; r: Value; res: Array );
- BEGIN
- Array1d.MultAV( l.data^, r, res.data^, 0, LEN( res.data ) );
- END MulAV;
- OPERATOR "*"( l: Array; r: Value ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, l.origin, l.len ); MulAV( l, r, res ); RETURN res;
- END "*";
- OPERATOR "*"( l: Value; r: Array ): Array;
- BEGIN
- RETURN r * l
- END "*";
- PROCEDURE DivAV*( l: Array; r: Value; res: Array );
- BEGIN
- Array1d.DivAV( l.data^, r, res.data^, 0, LEN( res.data ) );
- END DivAV;
- (*
- OPERATOR "DIV"( l: Array; r: Value ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, l.origin^, l.len^ ); DivAV( l, r, res ); RETURN res;
- END "DIV";
- *)
- PROCEDURE DivVA*( l: Value; r: Array; res: Array );
- BEGIN
- Array1d.DivVA( l, r.data^, res.data^, 0, LEN( res.data ) );
- END DivVA;
- (*
- OPERATOR "DIV"( l: Value; r: Array ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, r.origin^, r.len^ ); DivVA( l, r, res ); RETURN res;
- END "DIV";
- *)
- PROCEDURE ModAV*( l: Array; r: Value; res: Array );
- BEGIN
- Array1d.ModAV( l.data^, r, res.data^, 0, LEN( res.data ) );
- END ModAV;
- (*
- OPERATOR "MOD"( l: Array; r: Value ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, l.origin^, l.len^ ); ModAV( l, r, res ); RETURN res;
- END "MOD";
- *)
- PROCEDURE ModVA*( l: Value; r: Array; res: Array );
- BEGIN
- Array1d.ModVA( l, r.data^, res.data^, 0, LEN( res.data ) );
- END ModVA;
- (*
- OPERATOR "MOD"( l: Value; r: Array ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, r.origin^, r.len^ ); ModVA( l, r, res ); RETURN res;
- END "MOD";
- *)
- PROCEDURE SubAV*( l: Array; r: Value; res: Array );
- BEGIN
- Array1d.SubtractAV( l.data^, r, res.data^, 0, LEN( res.data ) );
- END SubAV;
- (*
- OPERATOR "-"( l: Array; r: Value ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, l.origin^, l.len^ ); SubAV( l, r, res ); RETURN res;
- END "-";
- *)
- PROCEDURE SubVA*( l: Value; r: Array; res: Array );
- BEGIN
- Array1d.SubtractVA( l, r.data^, res.data^, 0, LEN( res.data ) );
- END SubVA;
- OPERATOR "-"*( l: Value; r: Array ): Array;
- VAR res: Array;
- BEGIN
- NEW( res, r.origin, r.len ); SubVA( l, r, res ); RETURN res;
- END "-";
- (* The procedures needed to register an arbitrary Array so that its instances can be made persistent. *)
- PROCEDURE LoadArray( R: DataIO.Reader; VAR obj: OBJECT );
- VAR a: Array; version: SHORTINT; ver: NbrInt.Integer;
- BEGIN
- R.RawSInt( version );
- IF version = -1 THEN
- obj := NIL (* Version tag is -1 for NIL. *)
- ELSE
- IF version = VERSION THEN NEW( a, ArrayXdBytes.Array1( 0 ), ArrayXdBytes.Array1( 0 ) ); a.LoadXd( R ); obj := a
- ELSE (* Encountered an unknown version number. *)
- ver := version; DataErrors.IntError( ver, "Alien version number encountered." ); HALT( 1000 )
- END
- END
- END LoadArray;
- PROCEDURE StoreArray( W: DataIO.Writer; obj: OBJECT );
- VAR old: Array;
- BEGIN
- IF obj = NIL THEN W.RawSInt( -1 ) ELSE W.RawSInt( VERSION ); old := obj( Array ); old.StoreXd( W, TRUE ) END
- END StoreArray;
- PROCEDURE Register;
- VAR a: Array;
- BEGIN
- NEW( a, ArrayXdBytes.Array1( 0 ), ArrayXdBytes.Array1( 0 ) ); DataIO.PlugIn( a, LoadArray, StoreArray )
- END Register;
- (** Load and Store are procedures for external use that read/write an instance of an arbitrary array from/to a file. *)
- PROCEDURE Load*( R: DataIO.Reader; VAR obj: Array );
- VAR ptr: OBJECT;
- BEGIN
- R.Object( ptr ); obj := ptr( Array )
- END Load;
- PROCEDURE Store*( W: DataIO.Writer; obj: Array );
- BEGIN
- W.Object( obj )
- END Store;
- BEGIN
- Register
- END ArrayXdInt.
- System.Free ArrayXdInt ArrayXdBytes Array2dInt Array1dInt Array1dBytes ~
- ArrayXdInt.dbgTest ~
- Decoder.Decode ArrayXdInt.Obj ~
|