ArrayXdInt.Mod 44 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173
  1. (* CAPO - Computational Analysis Platform for Oberon - by Alan Freed and Felix Friedrich. *)
  2. (* Version 1, Update 2 *)
  3. MODULE ArrayXdInt; (** AUTHOR "fof"; PURPOSE "Basic operations on an X-dimensional array of Integer"; *)
  4. (** any item containing the string "dbg" is for debugging purposes only and will be removed from this module,
  5. do NOT use *)
  6. IMPORT SYSTEM, NbrInt, ArrayXdBytes, Array1d := Array1dInt, dbgOut := KernelLog, DataErrors, DataIO;
  7. CONST
  8. generic* = 0; vector* = 1; matrix* = 2; cube* = 3; hcube* = 4;
  9. (** The version used when reading/writing an arbitrary dimensional array to file. *)
  10. VERSION* = 1;
  11. StrictBoundaryC* = 0; (* data beyond limit -> TRAP *)
  12. AbsorbingBoundaryC* = 1; (* data beyond limit = zero*)
  13. PeriodicBoundaryC* = 2; (* data[x] =data[x MOD LEN(data)], torus *)
  14. SymmetricOnBoundaryC* = 3; (* mirror boundaries, using border point once; W= reflection centered on point N *)
  15. SymmetricOffBoundaryC* = 4; (* mirror boundaries, using border point twice; reflection centered between point N and point N+1 *)
  16. AntisymmetricOnBoundaryC* = 5; (* like SymmetricOnBoundaryC but with additional change of sign if out of bounds *)
  17. AntisymmetricOffBoundaryC* = 6; (* like SymmetricOffBoundaryC but with additional change of sign if out of bounds *)
  18. TYPE
  19. Value* = Array1d.Value; Index* = LONGINT; Array1* = Array1d.Array;
  20. Array2* = POINTER TO ARRAY OF ARRAY OF Value;
  21. Array3* = POINTER TO ARRAY OF ARRAY OF ARRAY OF Value;
  22. Array4* = POINTER TO ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value;
  23. Map* = Array1d.Map;
  24. (** Class Array has been DataIO registered, and therefore, any instance of it can be made persistent
  25. by using the DataIO Reader and Writer, or more simply, by calling procedures Load and Store below. *)
  26. Array* = OBJECT (ArrayXdBytes.Array)
  27. VAR data-: Array1; (*! will probably be removed, do not use ! *)
  28. (** override *)
  29. PROCEDURE Allocate*( size: LONGINT; VAR adr: Index; VAR ptr: ANY );
  30. BEGIN
  31. NEW( data, size ); adr := ADDRESSOF( data[0] ); ptr := data;
  32. END Allocate;
  33. PROCEDURE GetInfo*( VAR elementsize: Index );
  34. BEGIN
  35. elementsize := SIZEOF( Value );
  36. END GetInfo;
  37. PROCEDURE AlikeX*( ): ArrayXdBytes.Array;
  38. VAR copy: Array;
  39. BEGIN
  40. NEW( copy, origin, len ); RETURN copy;
  41. END AlikeX;
  42. (** new *)
  43. (** Read and Write are for internal use only.
  44. Exporting them permits extensible, persistent, data types to be constructed. *)
  45. PROCEDURE Read*( R: DataIO.Reader );
  46. BEGIN {EXCLUSIVE}
  47. LoadXd( R )
  48. END Read;
  49. PROCEDURE Write*( W: DataIO.Writer );
  50. BEGIN
  51. StoreXd( W, TRUE )
  52. END Write;
  53. PROCEDURE Type*( ): SHORTINT;
  54. (* generic, vector, matrix, cube, hcube *)
  55. BEGIN
  56. IF dim < 5 THEN RETURN SHORT( SHORT( dim ) ) ELSE RETURN 0 END;
  57. END Type;
  58. PROCEDURE Get1*( x: Index ): Value;
  59. VAR v: Value;
  60. BEGIN
  61. ArrayXdBytes.Get1( SELF, x, v ); RETURN v;
  62. END Get1;
  63. PROCEDURE Set1*( x: Index; v: Value );
  64. BEGIN
  65. ArrayXdBytes.Set1( SELF, x, v );
  66. END Set1;
  67. PROCEDURE Get2*( x, y: Index ): Value;
  68. VAR v: Value;
  69. BEGIN
  70. ArrayXdBytes.Get2( SELF, x, y, v ); RETURN v;
  71. END Get2;
  72. PROCEDURE Set2*( x, y: Index; v: Value );
  73. BEGIN
  74. ArrayXdBytes.Set2( SELF, x, y, v );
  75. END Set2;
  76. PROCEDURE Get3*( x, y, z: Index ): Value;
  77. VAR v: Value;
  78. BEGIN
  79. ArrayXdBytes.Get3( SELF, x, y, z, v ); RETURN v;
  80. END Get3;
  81. PROCEDURE Set3*( x, y, z: Index; v: Value );
  82. BEGIN
  83. ArrayXdBytes.Set3( SELF, x, y, z, v );
  84. END Set3;
  85. PROCEDURE Get4*( x, y, z, t: Index ): Value;
  86. VAR v: Value;
  87. BEGIN
  88. ArrayXdBytes.Get4( SELF, x, y, z, t, v ); RETURN v;
  89. END Get4;
  90. PROCEDURE Set4*( x, y, z, t: Index; v: Value );
  91. BEGIN
  92. ArrayXdBytes.Set4( SELF, x, y, z, t, v );
  93. END Set4;
  94. PROCEDURE GetX*( VAR x: ARRAY OF Index; dim: Index ): Value;
  95. VAR v: Value;
  96. BEGIN
  97. ArrayXdBytes.GetX( SELF, x, dim, v ); RETURN v;
  98. END GetX;
  99. PROCEDURE SetX*( VAR x: ARRAY OF Index; dim: Index; v: Value );
  100. BEGIN
  101. ArrayXdBytes.SetX( SELF, x, dim, v );
  102. END SetX;
  103. (*** Get with boundary conditions *)
  104. (** absorbing: data beyond limit = zero *)
  105. PROCEDURE Get1BAbsorbing*( x: Index ): Value;
  106. VAR v: Value;
  107. BEGIN
  108. IF ArrayXdBytes.InBounds( o0, l0, x ) THEN ArrayXdBytes.Get1( SELF, x, v ); RETURN v ELSE RETURN 0 END;
  109. END Get1BAbsorbing;
  110. PROCEDURE Get2BAbsorbing*( x, y: Index ): Value;
  111. VAR v: Value;
  112. BEGIN
  113. IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) THEN
  114. ArrayXdBytes.Get2( SELF, x, y, v ); RETURN v
  115. ELSE RETURN 0
  116. END;
  117. END Get2BAbsorbing;
  118. PROCEDURE Get3BAbsorbing*( x, y, z: Index ): Value;
  119. VAR v: Value;
  120. BEGIN
  121. IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) THEN
  122. ArrayXdBytes.Get3( SELF, x, y, z, v ); RETURN v
  123. ELSE RETURN 0
  124. END;
  125. END Get3BAbsorbing;
  126. PROCEDURE Get4BAbsorbing*( x, y, z, t: Index ): Value;
  127. VAR v: Value;
  128. BEGIN
  129. IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) &
  130. ArrayXdBytes.InBounds( o3, l3, t ) THEN
  131. ArrayXdBytes.Get4( SELF, x, y, z, t, v ); RETURN v
  132. ELSE RETURN 0
  133. END;
  134. END Get4BAbsorbing;
  135. PROCEDURE GetXBAbsorbing*( b: ARRAY OF Index; dim: Index ): Value;
  136. VAR v: Value; i: Index;
  137. BEGIN
  138. i := 0;
  139. WHILE (i < dim) DO
  140. IF ~ArrayXdBytes.InBounds( origin[i], len[i], b[i] ) THEN RETURN 0 END;
  141. INC( i );
  142. END;
  143. ArrayXdBytes.GetX( SELF, b, dim, v ); RETURN v
  144. END GetXBAbsorbing;
  145. (** periodic: data[x] =data[x MOD LEN(data)] *)
  146. PROCEDURE Get1BPeriodic*( x: Index ): Value;
  147. VAR v: Value;
  148. BEGIN
  149. ArrayXdBytes.Get1( SELF, ArrayXdBytes.PeriodicBounds( o0, l0, x ), v ); RETURN v
  150. END Get1BPeriodic;
  151. PROCEDURE Get2BPeriodic*( x, y: Index ): Value;
  152. VAR v: Value;
  153. BEGIN
  154. ArrayXdBytes.Get2( SELF, ArrayXdBytes.PeriodicBounds( o0, l0, x ), ArrayXdBytes.PeriodicBounds( o1, l1, y ), v );
  155. RETURN v
  156. END Get2BPeriodic;
  157. PROCEDURE Get3BPeriodic*( x, y, z: Index ): Value;
  158. VAR v: Value;
  159. BEGIN
  160. ArrayXdBytes.Get3( SELF, ArrayXdBytes.PeriodicBounds( o0, l0, x ), ArrayXdBytes.PeriodicBounds( o1, l1, y ),
  161. ArrayXdBytes.PeriodicBounds( o2, l2, z ), v );
  162. RETURN v
  163. END Get3BPeriodic;
  164. PROCEDURE Get4BPeriodic*( x, y, z, t: Index ): Value;
  165. VAR v: Value;
  166. BEGIN
  167. ArrayXdBytes.Get4( SELF, ArrayXdBytes.PeriodicBounds( o0, l0, x ), ArrayXdBytes.PeriodicBounds( o1, l1, y ),
  168. ArrayXdBytes.PeriodicBounds( o2, l2, z ), ArrayXdBytes.PeriodicBounds( o3, l3, z ), v );
  169. RETURN v
  170. END Get4BPeriodic;
  171. PROCEDURE GetXBPeriodic*( b: ARRAY OF Index; dim: Index ): Value;
  172. VAR v: Value; i: Index;
  173. BEGIN
  174. i := 0;
  175. WHILE (i < dim) DO b[i] := ArrayXdBytes.PeriodicBounds( origin[i], len[i], b[i] ); INC( i ) END;
  176. ArrayXdBytes.GetX( SELF, b, dim, v ); RETURN v
  177. END GetXBPeriodic;
  178. (** mirror boundaries, using border point twice; reflection centered between point N and point N+1 *)
  179. PROCEDURE Get1BSymmetricOffB*( x: Index ): Value;
  180. VAR v: Value;
  181. BEGIN
  182. ArrayXdBytes.Get1( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), v ); RETURN v
  183. END Get1BSymmetricOffB;
  184. PROCEDURE Get2BSymmetricOffB*( x, y: Index ): Value;
  185. VAR v: Value;
  186. BEGIN
  187. ArrayXdBytes.Get2( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ), v ); RETURN v
  188. END Get2BSymmetricOffB;
  189. PROCEDURE Get3BSymmetricOffB*( x, y, z: Index ): Value;
  190. VAR v: Value;
  191. BEGIN
  192. ArrayXdBytes.Get3( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ),
  193. ArrayXdBytes.MirrorOffB( o2, l2, z ), v );
  194. RETURN v
  195. END Get3BSymmetricOffB;
  196. PROCEDURE Get4BSymmetricOffB*( x, y, z, t: Index ): Value;
  197. VAR v: Value;
  198. BEGIN
  199. ArrayXdBytes.Get4( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ),
  200. ArrayXdBytes.MirrorOffB( o2, l2, z ), ArrayXdBytes.MirrorOffB( o3, l3, z ), v );
  201. RETURN v
  202. END Get4BSymmetricOffB;
  203. PROCEDURE GetXBSymmetricOffB*( b: ARRAY OF Index; dim: Index ): Value;
  204. VAR v: Value; i: Index;
  205. BEGIN
  206. i := 0;
  207. WHILE (i < dim) DO b[i] := ArrayXdBytes.MirrorOffB( origin[i], len[i], b[i] ); INC( i ) END;
  208. ArrayXdBytes.GetX( SELF, b, dim, v ); RETURN v
  209. END GetXBSymmetricOffB;
  210. (** mirror boundaries, using border point once; reflection centered on point N*)
  211. PROCEDURE Get1BSymmetricOnB*( x: Index ): Value;
  212. VAR v: Value;
  213. BEGIN
  214. x := ArrayXdBytes.MirrorOnB( o0, l0, x ); ArrayXdBytes.Get1( SELF, x, v ); RETURN v
  215. END Get1BSymmetricOnB;
  216. PROCEDURE Get2BSymmetricOnB*( x, y: Index ): Value;
  217. VAR v: Value;
  218. BEGIN
  219. x := ArrayXdBytes.MirrorOnB( o0, l0, x ); y := ArrayXdBytes.MirrorOnB( o1, l1, y );
  220. ArrayXdBytes.Get2( SELF, x, y, v ); RETURN v
  221. END Get2BSymmetricOnB;
  222. PROCEDURE Get3BSymmetricOnB*( x, y, z: Index ): Value;
  223. VAR v: Value;
  224. BEGIN
  225. x := ArrayXdBytes.MirrorOnB( o0, l0, x ); y := ArrayXdBytes.MirrorOnB( o1, l1, y );
  226. z := ArrayXdBytes.MirrorOnB( o2, l2, z ); ArrayXdBytes.Get3( SELF, x, y, z, v ); RETURN v
  227. END Get3BSymmetricOnB;
  228. PROCEDURE Get4BSymmetricOnB*( x, y, z, t: Index ): Value;
  229. VAR v: Value;
  230. BEGIN
  231. x := ArrayXdBytes.MirrorOnB( o0, l0, x ); y := ArrayXdBytes.MirrorOnB( o1, l1, y );
  232. z := ArrayXdBytes.MirrorOnB( o2, l2, z ); t := ArrayXdBytes.MirrorOnB( o3, l3, z );
  233. ArrayXdBytes.Get4( SELF, x, y, z, t, v ); RETURN v
  234. END Get4BSymmetricOnB;
  235. PROCEDURE GetXBSymmetricOnB*( b: ARRAY OF Index; dim: Index ): Value;
  236. VAR v: Value; i: Index;
  237. BEGIN
  238. i := 0;
  239. WHILE (i < dim) DO b[i] := ArrayXdBytes.MirrorOnB( origin[i], len[i], b[i] ); INC( i ) END;
  240. ArrayXdBytes.GetX( SELF, b, dim, v ); RETURN v
  241. END GetXBSymmetricOnB;
  242. (* like SymmetricOffB but with change of sign if not in range *)
  243. PROCEDURE Get1BAntisymmetricOffB*( x: Index ): Value;
  244. VAR v: Value;
  245. BEGIN
  246. IF ArrayXdBytes.InBounds( o0, l0, x ) THEN ArrayXdBytes.Get1( SELF, x, v ); RETURN v
  247. ELSE ArrayXdBytes.Get1( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), v ); RETURN -v;
  248. END;
  249. END Get1BAntisymmetricOffB;
  250. PROCEDURE Get2BAntisymmetricOffB*( x, y: Index ): Value;
  251. VAR v: Value;
  252. BEGIN
  253. IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) THEN
  254. ArrayXdBytes.Get2( SELF, x, y, v ); RETURN v
  255. ELSE
  256. ArrayXdBytes.Get2( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ), v ); RETURN -v
  257. END;
  258. END Get2BAntisymmetricOffB;
  259. PROCEDURE Get3BAntisymmetricOffB*( x, y, z: Index ): Value;
  260. VAR v: Value;
  261. BEGIN
  262. IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) THEN
  263. ArrayXdBytes.Get3( SELF, x, y, z, v ); RETURN v
  264. ELSE
  265. ArrayXdBytes.Get3( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ),
  266. ArrayXdBytes.MirrorOffB( o2, l2, z ), v );
  267. RETURN -v
  268. END;
  269. END Get3BAntisymmetricOffB;
  270. PROCEDURE Get4BAntisymmetricOffB*( x, y, z, t: Index ): Value;
  271. VAR v: Value;
  272. BEGIN
  273. IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) &
  274. ArrayXdBytes.InBounds( o3, l3, t ) THEN
  275. ArrayXdBytes.Get4( SELF, x, y, z, t, v ); RETURN v
  276. ELSE
  277. ArrayXdBytes.Get4( SELF, ArrayXdBytes.MirrorOffB( o0, l0, x ), ArrayXdBytes.MirrorOffB( o1, l1, y ),
  278. ArrayXdBytes.MirrorOffB( o2, l2, z ), ArrayXdBytes.MirrorOffB( o3, l3, t ), v );
  279. RETURN -v
  280. END;
  281. END Get4BAntisymmetricOffB;
  282. PROCEDURE GetXBAntisymmetricOffB*( b: ARRAY OF Index; dim: Index ): Value;
  283. VAR v: Value; i: Index; inv: BOOLEAN;
  284. BEGIN
  285. i := 0; inv := FALSE;
  286. WHILE (i < dim) DO
  287. inv := inv OR (~ArrayXdBytes.InBounds( origin[i], len[i], b[i] ));
  288. b[i] := ArrayXdBytes.MirrorOffB( origin[i], len[i], b[i] ); INC( i );
  289. END;
  290. ArrayXdBytes.GetX( SELF, b, dim, v );
  291. IF inv THEN RETURN -v ELSE RETURN v END;
  292. END GetXBAntisymmetricOffB;
  293. (** like SymmetricOnB but with change of sign if not in range *)
  294. PROCEDURE Get1BAntisymmetricOnB*( x: Index ): Value;
  295. VAR v: Value;
  296. BEGIN
  297. IF ArrayXdBytes.InBounds( o0, l0, x ) THEN ArrayXdBytes.Get1( SELF, x, v ); RETURN v
  298. ELSE ArrayXdBytes.Get1( SELF, ArrayXdBytes.MirrorOnB( o0, l0, x ), v ); RETURN -v;
  299. END;
  300. END Get1BAntisymmetricOnB;
  301. PROCEDURE Get2BAntisymmetricOnB*( x, y: Index ): Value;
  302. VAR v: Value;
  303. BEGIN
  304. IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) THEN
  305. ArrayXdBytes.Get2( SELF, x, y, v ); RETURN v
  306. ELSE
  307. ArrayXdBytes.Get2( SELF, ArrayXdBytes.MirrorOnB( o0, l0, x ), ArrayXdBytes.MirrorOnB( o1, l1, y ), v ); RETURN -v
  308. END;
  309. END Get2BAntisymmetricOnB;
  310. PROCEDURE Get3BAntisymmetricOnB*( x, y, z: Index ): Value;
  311. VAR v: Value;
  312. BEGIN
  313. IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) THEN
  314. ArrayXdBytes.Get3( SELF, x, y, z, v ); RETURN v
  315. ELSE
  316. ArrayXdBytes.Get3( SELF, ArrayXdBytes.MirrorOnB( o0, l0, x ), ArrayXdBytes.MirrorOnB( o1, l1, y ),
  317. ArrayXdBytes.MirrorOnB( o2, l2, z ), v );
  318. RETURN -v
  319. END;
  320. END Get3BAntisymmetricOnB;
  321. PROCEDURE Get4BAntisymmetricOnB*( x, y, z, t: Index ): Value;
  322. VAR v: Value;
  323. BEGIN
  324. IF ArrayXdBytes.InBounds( o0, l0, x ) & ArrayXdBytes.InBounds( o1, l1, y ) & ArrayXdBytes.InBounds( o2, l2, z ) &
  325. ArrayXdBytes.InBounds( o3, l3, t ) THEN
  326. ArrayXdBytes.Get4( SELF, x, y, z, t, v ); RETURN v
  327. ELSE
  328. ArrayXdBytes.Get4( SELF, ArrayXdBytes.MirrorOnB( o0, l0, x ), ArrayXdBytes.MirrorOnB( o1, l1, y ),
  329. ArrayXdBytes.MirrorOnB( o2, l2, z ), ArrayXdBytes.MirrorOnB( o3, l3, t ), v );
  330. RETURN -v
  331. END;
  332. END Get4BAntisymmetricOnB;
  333. PROCEDURE GetXBAntisymmetricOnB*( b: ARRAY OF Index; dim: Index ): Value;
  334. VAR v: Value; i: Index; inv: BOOLEAN;
  335. BEGIN
  336. i := 0; inv := FALSE;
  337. WHILE (i < dim) DO
  338. inv := inv OR (~ArrayXdBytes.InBounds( origin[i], len[i], b[i] ));
  339. b[i] := ArrayXdBytes.MirrorOnB( origin[i], len[i], b[i] ); INC( i );
  340. END;
  341. ArrayXdBytes.GetX( SELF, b, dim, v );
  342. IF inv THEN RETURN -v ELSE RETURN v END;
  343. END GetXBAntisymmetricOnB;
  344. (** copy using the current boundary condition SELF.bc*)
  345. PROCEDURE CopyToArray*( dest: Array; srcpos, srclen, destpos, destlen: ArrayXdBytes.IndexArray );
  346. BEGIN
  347. CopyArrayToArrayPartB( SELF, dest, bc, srcpos, srclen, destpos, destlen );
  348. END CopyToArray;
  349. (** apply map m to all entries, dimension ordering is not necessarily preserved! *)
  350. PROCEDURE MapAll*( m: Array1d.Map );
  351. BEGIN
  352. IF m # NIL THEN Array1d.ApplyMap( m, data^, 0, LEN( data ) ); ELSE DataErrors.Error( "A NIL mapping function was supplied." ) END
  353. END MapAll;
  354. PROCEDURE Negate*;
  355. BEGIN {EXCLUSIVE}
  356. Array1d.Negate( data^, 0, LEN( data ) );
  357. (*
  358. FOR i := 0 TO len - 1 DO vec[i] := -vec[i] END
  359. *)
  360. END Negate;
  361. (** arr := arr+x *)
  362. PROCEDURE Add*( x: Array );
  363. BEGIN
  364. IF x # NIL THEN
  365. IF LEN( data ) = LEN( x.data ) THEN
  366. BEGIN {EXCLUSIVE}
  367. (*FOR i := 0 TO len - 1 DO vec[i] := vec[i] - x.vec[i] END*)
  368. Array1d.AddAA( data^, x.data^, data^, 0, len[0] );
  369. END
  370. ELSE DataErrors.Error( "Lengths of the two arrays were not equal." )
  371. END
  372. ELSE DataErrors.Error( "The supplied array to be subtracted was NIL." )
  373. END
  374. END Add;
  375. (** arr := arr-x *)
  376. PROCEDURE Subtract*( x: Array );
  377. BEGIN
  378. IF x # NIL THEN
  379. IF LEN( data ) = LEN( x.data ) THEN
  380. BEGIN {EXCLUSIVE}
  381. (*FOR i := 0 TO len - 1 DO vec[i] := vec[i] - x.vec[i] END*)
  382. Array1d.SubtractAA( data^, x.data^, data^, 0, len[0] );
  383. END
  384. ELSE DataErrors.Error( "Lengths of the two arrays were not equal." )
  385. END
  386. ELSE DataErrors.Error( "The supplied array to be subtracted was NIL." )
  387. END
  388. END Subtract;
  389. (* arr[i] := a*arr[i] forall i*)
  390. PROCEDURE Multiply*( a: Value );
  391. VAR i: Index;
  392. BEGIN {EXCLUSIVE}
  393. FOR i := 0 TO LEN( data ) - 1 DO data[i] := a * data[i] END
  394. END Multiply;
  395. (** arr[i] :=arr[i] / a forall i *)
  396. PROCEDURE Divide*( a: Value );
  397. VAR i: Index;
  398. BEGIN
  399. IF a # 0 THEN
  400. BEGIN {EXCLUSIVE}
  401. FOR i := 0 TO LEN( data ) - 1 DO data[i] := data[i] DIV a; END
  402. END;
  403. ELSE DataErrors.Error( "Division by zero." )
  404. END
  405. END Divide;
  406. (** arr[i] :=arr[i] MOD a forall i *)
  407. PROCEDURE Modulus*( a: Value );
  408. VAR i: Index;
  409. BEGIN
  410. IF a # 0 THEN
  411. BEGIN {EXCLUSIVE}
  412. FOR i := 0 TO LEN( data ) - 1 DO data[i] := data[i] MOD a END
  413. END
  414. ELSE DataErrors.Error( "Division by zero." )
  415. END
  416. END Modulus;
  417. PROCEDURE dbgWrite*;
  418. VAR x, y, z: LONGINT;
  419. BEGIN
  420. IF Type() = vector THEN
  421. dbgOut.String( "|" );
  422. FOR x := origin[0] TO origin[0] + len[0] - 1 DO dbgOut.Int( Get1( x ), 12 ); dbgOut.String( "|" ); END;
  423. dbgOut.Ln;
  424. ELSIF Type() = matrix THEN
  425. FOR y := origin[1] TO origin[1] + len[1] - 1 DO
  426. dbgOut.String( "|" );
  427. FOR x := origin[0] TO origin[0] + len[0] - 1 DO dbgOut.Int( Get2( x, y ), 12 ); dbgOut.String( "|" ); END;
  428. dbgOut.Ln;
  429. END;
  430. ELSIF Type() = cube THEN
  431. FOR z := origin[2] TO origin[2] + len[2] - 1 DO
  432. dbgOut.String( "z=" ); dbgOut.Int( z, 0 ); dbgOut.Ln;
  433. FOR y := origin[1] TO origin[1] + len[1] - 1 DO
  434. dbgOut.String( "|" );
  435. FOR x := origin[0] TO origin[0] + len[0] - 1 DO dbgOut.Int( Get3( x, y, z ), 12 ); dbgOut.String( "|" ); END;
  436. dbgOut.Ln;
  437. END;
  438. dbgOut.Ln;
  439. END;
  440. END;
  441. END dbgWrite;
  442. END Array;
  443. PROCEDURE New1d*( ox, w: Index ): Array;
  444. VAR res: Array;
  445. BEGIN
  446. NEW( res, ArrayXdBytes.Array1( ox ), ArrayXdBytes.Array1( w ) ); RETURN res;
  447. END New1d;
  448. PROCEDURE New2d*( ox, w, oy, h: Index ): Array;
  449. VAR res: Array;
  450. BEGIN
  451. NEW( res, ArrayXdBytes.Array2( ox, oy ), ArrayXdBytes.Array2( w, h ) ); RETURN res;
  452. END New2d;
  453. PROCEDURE New3d*( ox, w, oy, h, oz, d: Index ): Array;
  454. VAR res: Array;
  455. BEGIN
  456. NEW( res, ArrayXdBytes.Array3( ox, oy, oz ), ArrayXdBytes.Array3( w, h, d ) ); RETURN res;
  457. END New3d;
  458. PROCEDURE New4d*( ox, w, oy, h, oz, d, ot, dt: Index ): Array;
  459. VAR res: Array;
  460. BEGIN
  461. NEW( res, ArrayXdBytes.Array4( ox, oy, oz, ot ), ArrayXdBytes.Array4( w, h, d, dt ) ); RETURN res;
  462. END New4d;
  463. PROCEDURE CopyVecToVec*( src, dest: Array; srcx, destx, len: Index );
  464. BEGIN
  465. IF (src.dim # 1) OR (dest.dim # 1) THEN HALT( 1001 ) END;
  466. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index1( srcx ), ArrayXdBytes.Index1( len ),
  467. ArrayXdBytes.Index1( destx ), ArrayXdBytes.Index1( len ) );
  468. END CopyVecToVec;
  469. PROCEDURE CopyMtxToVec*( src, dest: Array; dim: Index; srcx, srcy, destx, len: Index );
  470. VAR slen: ArrayXdBytes.IndexArray;
  471. BEGIN
  472. IF (src.dim # 2) OR (dest.dim # 1) THEN HALT( 1002 ) END;
  473. slen := ArrayXdBytes.Index2( 1, 1 ); slen[dim] := len;
  474. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index2( srcx, srcy ), slen,
  475. ArrayXdBytes.Index1( destx ), ArrayXdBytes.Index1( len ) );
  476. END CopyMtxToVec;
  477. PROCEDURE CopyVecToMtx*( src, dest: Array; dim: Index; srcx, destx, desty, len: Index );
  478. VAR slen: ArrayXdBytes.IndexArray;
  479. BEGIN
  480. IF (src.dim # 1) OR (dest.dim # 2) THEN HALT( 1002 ) END;
  481. slen := ArrayXdBytes.Index2( 1, 1 ); slen[dim] := len;
  482. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index1( srcx ), ArrayXdBytes.Index1( len ),
  483. ArrayXdBytes.Index2( destx, desty ), slen );
  484. END CopyVecToMtx;
  485. PROCEDURE CopyCubeToVec*( src, dest: Array; dim: Index; srcx, srcy, srcz, destx, len: Index );
  486. VAR slen: ArrayXdBytes.IndexArray;
  487. BEGIN
  488. IF (src.dim # 3) OR (dest.dim # 1) THEN HALT( 1003 ) END;
  489. slen := ArrayXdBytes.Index3( 1, 1, 1 ); slen[dim] := len;
  490. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index3( srcx, srcy, srcz ), slen,
  491. ArrayXdBytes.Index1( destx ), ArrayXdBytes.Index1( len ) );
  492. END CopyCubeToVec;
  493. PROCEDURE CopyVecToCube*( src, dest: Array; dim: Index; srcx, destx, desty, destz, len: Index );
  494. VAR slen: ArrayXdBytes.IndexArray;
  495. BEGIN
  496. IF (src.dim # 1) OR (dest.dim # 3) THEN HALT( 1002 ) END;
  497. slen := ArrayXdBytes.Index3( 1, 1, 1 ); slen[dim] := len;
  498. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index1( srcx ), ArrayXdBytes.Index1( len ),
  499. ArrayXdBytes.Index3( destx, desty, destz ), slen );
  500. END CopyVecToCube;
  501. PROCEDURE CopyHCubeToVec*( src, dest: Array; dim: Index; srcx, srcy, srcz, srct, destx, len: Index );
  502. VAR slen: ArrayXdBytes.IndexArray;
  503. BEGIN
  504. IF (src.dim # 4) OR (dest.dim # 1) THEN HALT( 1004 ) END;
  505. slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dim] := len;
  506. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ), slen,
  507. ArrayXdBytes.Index1( destx ), ArrayXdBytes.Index1( len ) );
  508. END CopyHCubeToVec;
  509. PROCEDURE CopyVecToHCube*( src, dest: Array; dim: Index; srcx, destx, desty, destz, destt, len: Index );
  510. VAR slen: ArrayXdBytes.IndexArray;
  511. BEGIN
  512. IF (src.dim # 1) OR (dest.dim # 4) THEN HALT( 1002 ) END;
  513. slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dim] := len;
  514. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index1( srcx ), ArrayXdBytes.Index1( len ),
  515. ArrayXdBytes.Index4( destx, desty, destz, destt ), slen );
  516. END CopyVecToHCube;
  517. PROCEDURE CopyMtxToMtx*( src, dest: Array; srcx, srcy, destx, desty, lenx, leny: Index );
  518. VAR slen: ArrayXdBytes.IndexArray;
  519. BEGIN
  520. IF (src.dim # 2) OR (dest.dim # 2) THEN HALT( 1005 ) END;
  521. slen := ArrayXdBytes.Index2( lenx, leny );
  522. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index2( srcx, srcy ), slen,
  523. ArrayXdBytes.Index2( destx, desty ), slen );
  524. END CopyMtxToMtx;
  525. PROCEDURE CopyCubeToMtx*( src, dest: Array; dimx, dimy: Index; srcx, srcy, srcz, destx, desty, lenx, leny: Index );
  526. VAR slen: ArrayXdBytes.IndexArray;
  527. BEGIN
  528. IF (src.dim # 3) OR (dest.dim # 2) THEN HALT( 1005 ) END;
  529. slen := ArrayXdBytes.Index3( 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny;
  530. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index3( srcx, srcy, srcz ), slen,
  531. ArrayXdBytes.Index2( destx, desty ), ArrayXdBytes.Index2( lenx, leny ) );
  532. END CopyCubeToMtx;
  533. PROCEDURE CopyMtxToCube*( src, dest: Array; dimx, dimy: Index; srcx, srcy, destx, desty, destz, lenx, leny: Index );
  534. VAR slen: ArrayXdBytes.IndexArray;
  535. BEGIN
  536. IF (src.dim # 2) OR (dest.dim # 3) THEN HALT( 1005 ) END;
  537. slen := ArrayXdBytes.Index3( 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny;
  538. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index2( srcx, srcy ), ArrayXdBytes.Index2( lenx, leny ),
  539. ArrayXdBytes.Index3( destx, desty, destz ), slen );
  540. END CopyMtxToCube;
  541. PROCEDURE CopyHCubeToMtx*( src, dest: Array; dimx, dimy: Index; srcx, srcy, srcz, srct, destx, desty, lenx, leny: Index );
  542. VAR slen: ArrayXdBytes.IndexArray;
  543. BEGIN
  544. IF (src.dim # 4) OR (dest.dim # 2) THEN HALT( 1005 ) END;
  545. slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny;
  546. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ), slen,
  547. ArrayXdBytes.Index2( destx, desty ), ArrayXdBytes.Index2( lenx, leny ) );
  548. END CopyHCubeToMtx;
  549. PROCEDURE CopyMtxToHCube*( src, dest: Array; dimx, dimy: Index;
  550. srcx, srcy, destx, desty, destz, destt, lenx, leny: Index );
  551. VAR slen: ArrayXdBytes.IndexArray;
  552. BEGIN
  553. IF (src.dim # 2) OR (dest.dim # 4) THEN HALT( 1005 ) END;
  554. slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny;
  555. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index2( srcx, srcy ), ArrayXdBytes.Index2( lenx, leny ),
  556. ArrayXdBytes.Index4( destx, desty, destz, destt ), slen );
  557. END CopyMtxToHCube;
  558. PROCEDURE CopyCubeToCube*( src, dest: Array; srcx, srcy, srcz, destx, desty, destz, lenx, leny, lenz: Index );
  559. VAR slen: ArrayXdBytes.IndexArray;
  560. BEGIN
  561. IF (src.dim # 3) OR (dest.dim # 3) THEN HALT( 1005 ) END;
  562. slen := ArrayXdBytes.Index3( lenx, leny, lenz );
  563. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index3( srcx, srcy, srcz ), slen,
  564. ArrayXdBytes.Index3( destx, desty, destz ), slen );
  565. END CopyCubeToCube;
  566. PROCEDURE CopyHCubeToCube*( src, dest: Array; dimx, dimy, dimz: Index;
  567. srcx, srcy, srcz, srct, destx, desty, destz, lenx, leny, lenz: Index );
  568. VAR slen: ArrayXdBytes.IndexArray;
  569. BEGIN
  570. IF (src.dim # 4) OR (dest.dim # 3) THEN HALT( 1005 ) END;
  571. slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny; slen[dimz] := lenz;
  572. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ), slen,
  573. ArrayXdBytes.Index3( destx, desty, destz ),
  574. ArrayXdBytes.Index3( lenx, leny, lenz ) );
  575. END CopyHCubeToCube;
  576. PROCEDURE CopyCubeToHCube*( src, dest: Array; dimx, dimy, dimz: Index;
  577. srcx, srcy, srcz, destx, desty, destz, destt, lenx, leny, lenz: Index );
  578. VAR slen: ArrayXdBytes.IndexArray;
  579. BEGIN
  580. IF (src.dim # 3) OR (dest.dim # 4) THEN HALT( 1005 ) END;
  581. slen := ArrayXdBytes.Index4( 1, 1, 1, 1 ); slen[dimx] := lenx; slen[dimy] := leny; slen[dimz] := lenz;
  582. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index3( srcx, srcy, srcz ),
  583. ArrayXdBytes.Index3( lenx, leny, lenz ),
  584. ArrayXdBytes.Index4( destx, desty, destz, destt ), slen );
  585. END CopyCubeToHCube;
  586. PROCEDURE CopyHCubeToHCube*( src, dest: Array;
  587. srcx, srcy, srcz, srct, destx, desty, destz, destt, lenx, leny, lenz, lent: Index );
  588. VAR slen: ArrayXdBytes.IndexArray;
  589. BEGIN
  590. IF (src.dim # 4) OR (dest.dim # 4) THEN HALT( 1005 ) END;
  591. slen := ArrayXdBytes.Index4( lenx, leny, lenz, lent );
  592. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ), slen,
  593. ArrayXdBytes.Index4( destx, desty, destz, destt ), slen );
  594. END CopyHCubeToHCube;
  595. PROCEDURE CopyArrayToVec*( VAR src: ARRAY OF Value; dest: Array; srcx, destx, len: Index );
  596. BEGIN
  597. IF dest.dim # 1 THEN HALT( 1005 ) END;
  598. ArrayXdBytes.CheckLEQ( 0, srcx ); ArrayXdBytes.CheckLE( srcx + len, LEN( src ) );
  599. ArrayXdBytes.CopyMemoryToArrayPart( ADDRESSOF( src[srcx] ), dest, len, ArrayXdBytes.Index1( destx ),
  600. ArrayXdBytes.Index1( len ) );
  601. END CopyArrayToVec;
  602. PROCEDURE CopyVecToArray*( src: Array; VAR dest: ARRAY OF Value; srcx, destx, len: Index );
  603. BEGIN
  604. IF src.dim # 1 THEN HALT( 1005 ) END;
  605. ArrayXdBytes.CheckLEQ( 0, destx ); ArrayXdBytes.CheckLE( destx + len, LEN( dest ) );
  606. ArrayXdBytes.CopyArrayPartToMemory( src, ADDRESSOF( dest[destx] ), ArrayXdBytes.Index1( srcx ),
  607. ArrayXdBytes.Index1( len ), len );
  608. END CopyVecToArray;
  609. PROCEDURE CopyArrayToMtx*( VAR src: ARRAY OF ARRAY OF Value; dest: Array; srcx, srcy, destx, desty, lenx, leny: Index );
  610. VAR srcmem: ArrayXdBytes.ArrayMemoryStructure;
  611. BEGIN
  612. IF dest.dim # 2 THEN HALT( 1005 ) END;
  613. srcmem :=
  614. ArrayXdBytes.MakeMemoryStructure( 2, ArrayXdBytes.Index2( 0, 0 ), ArrayXdBytes.Index2( LEN( src, 1 ), LEN( src, 0 ) ),
  615. SIZEOF( Value ), ADDRESSOF( src[0, 0] ) );
  616. ArrayXdBytes.CopyArrayPartToArrayPart( srcmem, dest, ArrayXdBytes.Index2( srcx, srcy ),
  617. ArrayXdBytes.Index2( lenx, leny ), ArrayXdBytes.Index2( destx, desty ),
  618. ArrayXdBytes.Index2( lenx, leny ) );
  619. END CopyArrayToMtx;
  620. PROCEDURE CopyMtxToArray*( src: Array; VAR dest: ARRAY OF ARRAY OF Value; srcx, srcy, destx, desty, lenx, leny: Index );
  621. VAR destmem: ArrayXdBytes.ArrayMemoryStructure;
  622. BEGIN
  623. IF src.dim # 2 THEN HALT( 1005 ) END;
  624. destmem :=
  625. ArrayXdBytes.MakeMemoryStructure( 2, ArrayXdBytes.Index2( 0, 0 ), ArrayXdBytes.Index2( LEN( dest, 1 ), LEN( dest, 0 ) ),
  626. SIZEOF( Value ), ADDRESSOF( dest[0, 0] ) );
  627. ArrayXdBytes.CopyArrayPartToArrayPart( src, destmem, ArrayXdBytes.Index2( srcx, srcy ),
  628. ArrayXdBytes.Index2( lenx, leny ), ArrayXdBytes.Index2( destx, desty ),
  629. ArrayXdBytes.Index2( lenx, leny ) );
  630. END CopyMtxToArray;
  631. PROCEDURE CopyArrayToCube*( VAR src: ARRAY OF ARRAY OF ARRAY OF Value; dest: Array;
  632. srcx, srcy, srcz, destx, desty, destz, lenx, leny, lenz: Index );
  633. VAR srcmem: ArrayXdBytes.ArrayMemoryStructure;
  634. BEGIN
  635. IF dest.dim # 3 THEN HALT( 1005 ) END;
  636. srcmem :=
  637. ArrayXdBytes.MakeMemoryStructure( 3, ArrayXdBytes.Index3( 0, 0, 0 ),
  638. ArrayXdBytes.Index3( LEN( src, 2 ), LEN( src, 1 ), LEN( src, 0 ) ), SIZEOF( Value ),
  639. ADDRESSOF( src[0, 0, 0] ) );
  640. ArrayXdBytes.CopyArrayPartToArrayPart( srcmem, dest, ArrayXdBytes.Index3( srcx, srcy, srcz ),
  641. ArrayXdBytes.Index3( lenx, leny, lenz ),
  642. ArrayXdBytes.Index3( destx, desty, destz ),
  643. ArrayXdBytes.Index3( lenx, leny, lenz ) );
  644. END CopyArrayToCube;
  645. PROCEDURE CopyCubeToArray*( src: Array; VAR dest: ARRAY OF ARRAY OF ARRAY OF Value;
  646. srcx, srcy, srcz, destx, desty, destz, lenx, leny, lenz: Index );
  647. VAR destmem: ArrayXdBytes.ArrayMemoryStructure;
  648. BEGIN
  649. IF src.dim # 3 THEN HALT( 1005 ) END;
  650. destmem :=
  651. ArrayXdBytes.MakeMemoryStructure( 3, ArrayXdBytes.Index3( 0, 0, 0 ),
  652. ArrayXdBytes.Index3( LEN( dest, 2 ), LEN( dest, 1 ), LEN( dest, 0 ) ), SIZEOF( Value ),
  653. ADDRESSOF( dest[0, 0, 0] ) );
  654. ArrayXdBytes.CopyArrayPartToArrayPart( src, destmem, ArrayXdBytes.Index3( srcx, srcy, srcz ),
  655. ArrayXdBytes.Index3( lenx, leny, lenz ),
  656. ArrayXdBytes.Index3( destx, desty, destz ),
  657. ArrayXdBytes.Index3( lenx, leny, lenz ) );
  658. END CopyCubeToArray;
  659. PROCEDURE CopyArrayToHCube*( VAR src: ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value; dest: Array;
  660. srcx, srcy, srcz, srct, destx, desty, destz, destt, lenx, leny, lenz, lent: Index );
  661. VAR srcmem: ArrayXdBytes.ArrayMemoryStructure;
  662. BEGIN
  663. IF dest.dim # 4 THEN HALT( 1005 ) END;
  664. srcmem :=
  665. ArrayXdBytes.MakeMemoryStructure( 4, ArrayXdBytes.Index4( 0, 0, 0, 0 ),
  666. ArrayXdBytes.Index4( LEN( src, 3 ), LEN( src, 2 ), LEN( src, 1 ), LEN( src, 0 ) ), SIZEOF( Value ),
  667. ADDRESSOF( src[0, 0, 0] ) );
  668. ArrayXdBytes.CopyArrayPartToArrayPart( srcmem, dest, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ),
  669. ArrayXdBytes.Index4( lenx, leny, lenz, lent ),
  670. ArrayXdBytes.Index4( destx, desty, destz, destt ),
  671. ArrayXdBytes.Index4( lenx, leny, lenz, lent ) );
  672. END CopyArrayToHCube;
  673. PROCEDURE CopyHCubeToArray*( src: Array; VAR dest: ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value;
  674. srcx, srcy, srcz, srct, destx, desty, destz, destt, lenx, leny, lenz, lent: Index );
  675. VAR destmem: ArrayXdBytes.ArrayMemoryStructure;
  676. BEGIN
  677. IF src.dim # 4 THEN HALT( 1005 ) END;
  678. destmem :=
  679. ArrayXdBytes.MakeMemoryStructure( 4, ArrayXdBytes.Index4( 0, 0, 0, 0 ),
  680. ArrayXdBytes.Index4( LEN( dest, 3 ), LEN( dest, 2 ), LEN( dest, 1 ), LEN( dest, 0 ) ), SIZEOF( Value ),
  681. ADDRESSOF( dest[0, 0, 0] ) );
  682. ArrayXdBytes.CopyArrayPartToArrayPart( src, destmem, ArrayXdBytes.Index4( srcx, srcy, srcz, srct ),
  683. ArrayXdBytes.Index4( lenx, leny, lenz, lent ),
  684. ArrayXdBytes.Index4( destx, desty, destz, destt ),
  685. ArrayXdBytes.Index4( lenx, leny, lenz, lent ) );
  686. END CopyHCubeToArray;
  687. PROCEDURE CopyArrayToArrayPartB*( src: Array; dest: ArrayXdBytes.ArrayMemoryStructure; boundaryCondition: SHORTINT;
  688. srcpos, srclen, destpos, destlen: ArrayXdBytes.IndexArray );
  689. VAR temp: ArrayXdBytes.ArrayMemoryStructure;
  690. spos, dpos, last, borigin, blen, srcposcut, srclencut, destoffset: ArrayXdBytes.IndexArray; i, dim: LONGINT;
  691. val: Value; temp2: Array; enumB: ArrayXdBytes.BoundaryEnum;
  692. Get: PROCEDURE {DELEGATE} ( x: ARRAY OF Index;
  693. dim: Index ): Value;
  694. noinbound: BOOLEAN; v: Value;
  695. (* for debugging
  696. PROCEDURE OutIndex( idx: ArrayXdBytes.IndexArray; name: ARRAY OF CHAR );
  697. VAR i: LONGINT;
  698. BEGIN
  699. dbgOut.String( name );
  700. FOR i := 0 TO LEN( idx ) - 1 DO dbgOut.Int( idx[i], 1 ); dbgOut.String( "," ); END;
  701. dbgOut.Ln;
  702. END OutIndex;
  703. *)
  704. PROCEDURE Same( a, b: ArrayXdBytes.IndexArray ): BOOLEAN;
  705. BEGIN
  706. IF LEN( a ) # LEN( b ) THEN RETURN FALSE END;
  707. FOR i := 0 TO LEN( a ) - 1 DO
  708. IF a[i] # b[i] THEN RETURN FALSE END;
  709. END;
  710. RETURN TRUE;
  711. END Same;
  712. BEGIN
  713. dim := src.dim;
  714. IF boundaryCondition = StrictBoundaryC THEN
  715. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, srcpos, srclen, destpos, destlen ); (* checks are done there *)
  716. ELSE
  717. srcposcut := ArrayXdBytes.IndexCpy( srcpos ); srclencut := ArrayXdBytes.IndexCpy( srclen );
  718. NEW( enumB, src, srcposcut, srclencut );
  719. IF (Same( srcposcut, srcpos )) & (Same( srclencut, srclen )) THEN (* no boundaries *)
  720. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, srcpos, srclen, destpos, destlen ); RETURN;
  721. ELSE
  722. CASE boundaryCondition OF
  723. PeriodicBoundaryC:
  724. Get := src.GetXBPeriodic;
  725. | SymmetricOnBoundaryC:
  726. Get := src.GetXBSymmetricOnB;
  727. | SymmetricOffBoundaryC:
  728. Get := src.GetXBSymmetricOffB;
  729. | AntisymmetricOnBoundaryC:
  730. Get := src.GetXBAntisymmetricOnB;
  731. | AntisymmetricOffBoundaryC:
  732. Get := src.GetXBAntisymmetricOffB;
  733. | AbsorbingBoundaryC:
  734. ArrayXdBytes.FillArrayPart( dest, destpos, destlen, val ); (* fill with 0 first *)
  735. Get := NIL;
  736. END;
  737. NEW( destoffset, dim ); noinbound := FALSE;
  738. IF Same( srclen, destlen ) THEN (* same geometry, direct copy to boundary rects can be used*)
  739. FOR i := 0 TO dim - 1 DO
  740. destoffset[i] := destpos[i] + srcposcut[i] - srcpos[i];
  741. IF srclencut[i] = 0 THEN noinbound := TRUE END;
  742. END;
  743. IF ~noinbound THEN
  744. ArrayXdBytes.CopyArrayPartToArrayPart( src, dest, srcposcut, srclencut, destoffset, srclencut );
  745. END;
  746. FOR i := 0 TO dim - 1 DO destoffset[i] := destpos[i] - srcpos[i]; END;
  747. temp := dest;
  748. ELSE (* not the same geometry, direct copy using rectangles cannot be used *)
  749. NEW( temp2, srcpos, srclen ); temp := temp2;
  750. FOR i := 0 TO dim - 1 DO
  751. destoffset[i] := 0;
  752. IF srclencut[i] = 0 THEN noinbound := TRUE END;
  753. END;
  754. IF ~noinbound THEN
  755. ArrayXdBytes.CopyArrayPartToArrayPart( src, temp, srcposcut, srclencut, srcposcut, srclencut );
  756. END;
  757. END;
  758. IF Get # NIL THEN
  759. NEW( spos, dim ); NEW( dpos, dim ); NEW( last, dim );
  760. WHILE (enumB.Get( borigin, blen )) DO (* enumeration of rects describing the region out of range *)
  761. FOR i := 0 TO dim - 1 DO spos[i] := borigin[i]; last[i] := spos[i] + blen[i]; dpos[i] := spos[i] + destoffset[i] END;
  762. REPEAT
  763. v := Get( spos^, dim );
  764. SYSTEM.MOVE( ADDRESSOF( v ), ArrayXdBytes.AdrX( temp, dpos^, dim ), SIZEOF( Value ) ); (* optimize adress handling of destination, compute here ! *)
  765. (*temp.SetX( dpos^, dim, Get( spos^, dim ) );*) i := 0; INC( spos[i] ); INC( dpos[i] );
  766. WHILE (i < dim - 1) & (spos[i] = last[i]) DO
  767. spos[i] := borigin[i]; dpos[i] := destoffset[i] + borigin[i]; INC( i ); INC( spos[i] ); INC( dpos[i] );
  768. END;
  769. UNTIL spos[i] = last[i];
  770. END;
  771. END;
  772. IF temp # dest THEN ArrayXdBytes.CopyArrayPartToArrayPart( temp, dest, srcpos, srclen, destpos, destlen );
  773. END;
  774. END;
  775. END;
  776. END CopyArrayToArrayPartB;
  777. OPERATOR ":="*( VAR l: Array; VAR r: ARRAY OF ARRAY OF ARRAY OF ARRAY OF Value );
  778. BEGIN
  779. (* IF r = NIL THEN l := NIL; RETURN END; *)
  780. IF l = NIL THEN l := New4d( 0, LEN( r, 3 ), 0, LEN( r, 2 ), 0, LEN( r, 1 ), 0, LEN( r, 0 ) );
  781. ELSE l.NewRangeX( ArrayXdBytes.Array4( 0, 0, 0, 0 ), ArrayXdBytes.Array4( LEN( r, 3 ), LEN( r, 2 ), LEN( r, 1 ), LEN( r, 0 ) ), FALSE )
  782. END;
  783. ArrayXdBytes.CopyMemoryToArray( ADDRESSOF( r[0, 0, 0, 0] ), l, LEN( r, 0 ) * LEN( r, 1 ) * LEN( r, 2 ) * LEN( r, 3 ) );
  784. END ":=";
  785. OPERATOR ":="*( VAR l: Array; VAR r: ARRAY OF ARRAY OF ARRAY OF Value );
  786. BEGIN
  787. (* IF r = NIL THEN l := NIL; RETURN END; *)
  788. IF l = NIL THEN l := New3d( 0, LEN( r, 2 ), 0, LEN( r, 1 ), 0, LEN( r, 0 ) );
  789. ELSE l.NewRangeX( ArrayXdBytes.Array3( 0, 0, 0 ), ArrayXdBytes.Array3( LEN( r, 2 ), LEN( r, 1 ), LEN( r, 0 ) ), FALSE );
  790. END;
  791. ArrayXdBytes.CopyMemoryToArray( ADDRESSOF( r[0, 0, 0] ), l, LEN( r, 0 ) * LEN( r, 1 ) * LEN( r, 2 ) );
  792. END ":=";
  793. (*
  794. OPERATOR ":="( VAR l: Array; VAR r: ARRAY OF ARRAY OF Value );
  795. BEGIN
  796. (* IF r = NIL THEN l := NIL; RETURN END; *)
  797. IF l = NIL THEN l := New2d( 0, LEN( r, 1 ), 0, LEN( r, 0 ) )
  798. ELSE l.NewRangeX( ArrayXdBytes.Array2( 0, 0 ), ArrayXdBytes.Array2( LEN( r, 1 ), LEN( r, 0 ) ), FALSE );
  799. END;
  800. ArrayXdBytes.CopyMemoryToArray( ADDRESSOF( r[0, 0] ), l, LEN( r, 0 ) * LEN( r, 1 ) );
  801. END ":=";
  802. OPERATOR ":="( VAR l: Array; VAR r: ARRAY OF Value );
  803. BEGIN
  804. (* IF r = NIL THEN l := NIL; RETURN END; *)
  805. IF l = NIL THEN l := New1d( 0, LEN( r, 0 ) )
  806. ELSE l.NewRangeX( ArrayXdBytes.Array1( 0 ), ArrayXdBytes.Array1( LEN( r, 0 ) ), FALSE );
  807. END;
  808. ArrayXdBytes.CopyMemoryToArray( ADDRESSOF( r[0] ), l, LEN( r, 0 ) );
  809. END ":=";
  810. *)
  811. (***!never do this : *
  812. OPERATOR ":="( VAR l: Array; r: Vector );
  813. BEGIN
  814. IF r = NIL THEN l := NIL; RETURN END;
  815. IF l = NIL THEN NEW( l, r.origin^, r.len^ ) ELSE l.NewRangeX( r.origin^, r.len^, TRUE ); END;
  816. r.CopyElements( r.origin^, r.len^, l, l.origin^, l.len^ );
  817. END ":=";
  818. *)
  819. OPERATOR ":="*( VAR l: Array1; r: Array );
  820. BEGIN
  821. IF r = NIL THEN l := NIL; RETURN END;
  822. ArrayXdBytes.CheckEQ( 1, r.dim ); (*ArrayXdBytes.CheckEQ( r.origin[0], 0 ); *)
  823. IF (l = NIL ) OR (LEN( l ) # r.len[0]) THEN NEW( l, r.len[0] ); END;
  824. ArrayXdBytes.CopyArrayToMemory( r, ADDRESSOF( l[0] ), LEN( l, 0 ) );
  825. END ":=";
  826. OPERATOR ":="*( VAR l: Array2; r: Array );
  827. BEGIN
  828. IF r = NIL THEN l := NIL; RETURN END;
  829. ArrayXdBytes.CheckEQ( 2, r.dim ); (*ArrayXdBytes.CheckEQ( r.origin[0], 0 ); ArrayXdBytes.CheckEQ( r.origin[1], 0 ); *)
  830. 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;
  831. ArrayXdBytes.CopyArrayToMemory( r, ADDRESSOF( l[0, 0] ), LEN( l, 0 ) * LEN( l, 1 ) );
  832. END ":=";
  833. OPERATOR ":="*( VAR l: Array3; r: Array );
  834. BEGIN
  835. IF r = NIL THEN l := NIL; RETURN END;
  836. ArrayXdBytes.CheckEQ( 3, r.dim ); (*ArrayXdBytes.CheckEQ( r.origin[0], 0 ); ArrayXdBytes.CheckEQ( r.origin[1], 0 ); ArrayXdBytes.CheckEQ( r.origin[2], 0 ); *)
  837. 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;
  838. ArrayXdBytes.CopyArrayToMemory( r, ADDRESSOF( l[0, 0, 0] ), LEN( l, 0 ) * LEN( l, 1 ) * LEN( l, 2 ) );
  839. END ":=";
  840. (*
  841. OPERATOR ":="( VAR l: Array4; r: Array );
  842. BEGIN
  843. IF r = NIL THEN l := NIL; RETURN END;
  844. ArrayXdBytes.CheckEQ( 4, r.dim ); (*ArrayXdBytes.CheckEQ( r.origin[0], 0 ); ArrayXdBytes.CheckEQ( r.origin[1], 0 ); ArrayXdBytes.CheckEQ( r.origin[2], 0 );
  845. ArrayXdBytes.CheckEQ( r.origin[3], 0 ); *)
  846. 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
  847. NEW( l, r.len[3], r.len[2], r.len[1], r.len[0] );
  848. END;
  849. ArrayXdBytes.CopyArrayToMemory( r, ADDRESSOF( l[0, 0, 0, 0] ), LEN( l, 0 ) * LEN( l, 1 ) * LEN( l, 2 ) * LEN( l, 3 ) );
  850. END ":=";
  851. *)
  852. PROCEDURE Fill*( l: Array; r: Value );
  853. BEGIN
  854. Array1d.Fill( r, l.data^, 0, LEN( l.data ) );
  855. END Fill;
  856. OPERATOR ":="*( VAR l: Array; r: Value );
  857. BEGIN
  858. IF l # NIL THEN Fill( l, r ) END;
  859. END ":=";
  860. PROCEDURE Add*( l, r, res: Array );
  861. BEGIN
  862. ArrayXdBytes.CheckEqDimensions( l, r ); Array1d.AddAA( l.data^, r.data^, res.data^, 0, LEN( res.data ) );
  863. END Add;
  864. OPERATOR "+"*( l, r: Array ): Array;
  865. VAR res: Array;
  866. BEGIN
  867. NEW( res, l.origin, l.len ); Add( l, r, res ); RETURN res;
  868. END "+";
  869. PROCEDURE Sub*( l, r, res: Array );
  870. BEGIN
  871. ArrayXdBytes.CheckEqDimensions( l, r ); Array1d.SubtractAA( l.data^, r.data^, res.data^, 0, LEN( res.data ) );
  872. END Sub;
  873. OPERATOR "-"*( l, r: Array ): Array;
  874. VAR res: Array;
  875. BEGIN
  876. NEW( res, l.origin, l.len); Sub( l, r, res ); RETURN res;
  877. END "-";
  878. PROCEDURE Mul*( l, r, res: Array );
  879. BEGIN
  880. ArrayXdBytes.CheckEqDimensions( l, r ); Array1d.MultAA( l.data^, r.data^, res.data^, 0, LEN( res.data ) );
  881. END Mul;
  882. PROCEDURE Div*( l, r, res: Array );
  883. BEGIN
  884. ArrayXdBytes.CheckEqDimensions( l, r ); Array1d.DivAA( l.data^, r.data^, res.data^, 0, LEN( res.data ) );
  885. END Div;
  886. PROCEDURE Mod*( l, r, res: Array );
  887. BEGIN
  888. ArrayXdBytes.CheckEqDimensions( l, r ); Array1d.ModAA( l.data^, r.data^, res.data^, 0, LEN( res.data ) );
  889. END Mod;
  890. PROCEDURE AddAV*( l: Array; r: Value; res: Array );
  891. BEGIN
  892. Array1d.AddAV( l.data^, r, res.data^, 0, LEN( res.data ) );
  893. END AddAV;
  894. OPERATOR "+"( l: Array; r: Value ): Array;
  895. VAR res: Array;
  896. BEGIN
  897. NEW( res, l.origin, l.len ); AddAV( l, r, res ); RETURN res;
  898. END "+";
  899. OPERATOR "+"( l: Value; r: Array ): Array;
  900. BEGIN
  901. RETURN r + l
  902. END "+";
  903. PROCEDURE MulAV*( l: Array; r: Value; res: Array );
  904. BEGIN
  905. Array1d.MultAV( l.data^, r, res.data^, 0, LEN( res.data ) );
  906. END MulAV;
  907. OPERATOR "*"( l: Array; r: Value ): Array;
  908. VAR res: Array;
  909. BEGIN
  910. NEW( res, l.origin, l.len ); MulAV( l, r, res ); RETURN res;
  911. END "*";
  912. OPERATOR "*"( l: Value; r: Array ): Array;
  913. BEGIN
  914. RETURN r * l
  915. END "*";
  916. PROCEDURE DivAV*( l: Array; r: Value; res: Array );
  917. BEGIN
  918. Array1d.DivAV( l.data^, r, res.data^, 0, LEN( res.data ) );
  919. END DivAV;
  920. (*
  921. OPERATOR "DIV"( l: Array; r: Value ): Array;
  922. VAR res: Array;
  923. BEGIN
  924. NEW( res, l.origin^, l.len^ ); DivAV( l, r, res ); RETURN res;
  925. END "DIV";
  926. *)
  927. PROCEDURE DivVA*( l: Value; r: Array; res: Array );
  928. BEGIN
  929. Array1d.DivVA( l, r.data^, res.data^, 0, LEN( res.data ) );
  930. END DivVA;
  931. (*
  932. OPERATOR "DIV"( l: Value; r: Array ): Array;
  933. VAR res: Array;
  934. BEGIN
  935. NEW( res, r.origin^, r.len^ ); DivVA( l, r, res ); RETURN res;
  936. END "DIV";
  937. *)
  938. PROCEDURE ModAV*( l: Array; r: Value; res: Array );
  939. BEGIN
  940. Array1d.ModAV( l.data^, r, res.data^, 0, LEN( res.data ) );
  941. END ModAV;
  942. (*
  943. OPERATOR "MOD"( l: Array; r: Value ): Array;
  944. VAR res: Array;
  945. BEGIN
  946. NEW( res, l.origin^, l.len^ ); ModAV( l, r, res ); RETURN res;
  947. END "MOD";
  948. *)
  949. PROCEDURE ModVA*( l: Value; r: Array; res: Array );
  950. BEGIN
  951. Array1d.ModVA( l, r.data^, res.data^, 0, LEN( res.data ) );
  952. END ModVA;
  953. (*
  954. OPERATOR "MOD"( l: Value; r: Array ): Array;
  955. VAR res: Array;
  956. BEGIN
  957. NEW( res, r.origin^, r.len^ ); ModVA( l, r, res ); RETURN res;
  958. END "MOD";
  959. *)
  960. PROCEDURE SubAV*( l: Array; r: Value; res: Array );
  961. BEGIN
  962. Array1d.SubtractAV( l.data^, r, res.data^, 0, LEN( res.data ) );
  963. END SubAV;
  964. (*
  965. OPERATOR "-"( l: Array; r: Value ): Array;
  966. VAR res: Array;
  967. BEGIN
  968. NEW( res, l.origin^, l.len^ ); SubAV( l, r, res ); RETURN res;
  969. END "-";
  970. *)
  971. PROCEDURE SubVA*( l: Value; r: Array; res: Array );
  972. BEGIN
  973. Array1d.SubtractVA( l, r.data^, res.data^, 0, LEN( res.data ) );
  974. END SubVA;
  975. OPERATOR "-"*( l: Value; r: Array ): Array;
  976. VAR res: Array;
  977. BEGIN
  978. NEW( res, r.origin, r.len ); SubVA( l, r, res ); RETURN res;
  979. END "-";
  980. (* The procedures needed to register an arbitrary Array so that its instances can be made persistent. *)
  981. PROCEDURE LoadArray( R: DataIO.Reader; VAR obj: OBJECT );
  982. VAR a: Array; version: SHORTINT; ver: NbrInt.Integer;
  983. BEGIN
  984. R.RawSInt( version );
  985. IF version = -1 THEN
  986. obj := NIL (* Version tag is -1 for NIL. *)
  987. ELSE
  988. IF version = VERSION THEN NEW( a, ArrayXdBytes.Array1( 0 ), ArrayXdBytes.Array1( 0 ) ); a.LoadXd( R ); obj := a
  989. ELSE (* Encountered an unknown version number. *)
  990. ver := version; DataErrors.IntError( ver, "Alien version number encountered." ); HALT( 1000 )
  991. END
  992. END
  993. END LoadArray;
  994. PROCEDURE StoreArray( W: DataIO.Writer; obj: OBJECT );
  995. VAR old: Array;
  996. BEGIN
  997. IF obj = NIL THEN W.RawSInt( -1 ) ELSE W.RawSInt( VERSION ); old := obj( Array ); old.StoreXd( W, TRUE ) END
  998. END StoreArray;
  999. PROCEDURE Register;
  1000. VAR a: Array;
  1001. BEGIN
  1002. NEW( a, ArrayXdBytes.Array1( 0 ), ArrayXdBytes.Array1( 0 ) ); DataIO.PlugIn( a, LoadArray, StoreArray )
  1003. END Register;
  1004. (** Load and Store are procedures for external use that read/write an instance of an arbitrary array from/to a file. *)
  1005. PROCEDURE Load*( R: DataIO.Reader; VAR obj: Array );
  1006. VAR ptr: OBJECT;
  1007. BEGIN
  1008. R.Object( ptr ); obj := ptr( Array )
  1009. END Load;
  1010. PROCEDURE Store*( W: DataIO.Writer; obj: Array );
  1011. BEGIN
  1012. W.Object( obj )
  1013. END Store;
  1014. BEGIN
  1015. Register
  1016. END ArrayXdInt.
  1017. System.Free ArrayXdInt ArrayXdBytes Array2dInt Array1dInt Array1dBytes ~
  1018. ArrayXdInt.dbgTest ~
  1019. Decoder.Decode ArrayXdInt.Obj ~