File: array.c

package info (click to toggle)
yorick 1.4-14
  • links: PTS
  • area: main
  • in suites: potato
  • size: 5,948 kB
  • ctags: 6,609
  • sloc: ansic: 63,898; yacc: 889; makefile: 605; sh: 65; lisp: 60; fortran: 19
file content (814 lines) | stat: -rw-r--r-- 27,239 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
/*
    ARRAY.C

    $Id: array.c,v 1.1 1993/08/27 18:32:09 munro Exp $

    Implement Yorick array indexing.  This is one half of the Yorick
    Eval instruction -- the other half of Eval is function invocation,
    which is handled in fnctn.c.  An expression of the form:
       expr(index_list)
    where index_list is a comma delimited list of indices, is an indexed
    array if expr is any array data type (or a function invocation if
    expr is any function data type).  The following index types are
    handled here:

    (1) nil   - the corresponding dimension is copied to the result
    (2) any integer scalar  - reduces the rank of the result
    (3) any integer array   - replaces the corresponding dimension by
        (index list)          a copy of the index list dimensions
    (4) start:stop:step     - replaces the corresponding dimension by
        (range)               a 0-origin dimension 1+(stop-start)/step
    (5) rf:start:stop:step  - as (4), but the specified range function
                              is applied after gathering the result
    (6) -  or -:start:stop:step  - "pseudo index" adds a dimension to
                                    the result not in the original array
    (7) +  or +:start:stop:step   - "marked index" is a special form for
                                    matrix multiplication, pushes the
				    result index number onto the stack
    (8) ..    - "rubber index" causes any subsequent indices to be right
                justified, copying as many dimensions to the result as
                required in order to do this
    (9) where(0)   - "nuller index" causes result to be nil, a special
                     case of the index list for a zero length list

    Index values may fall into 3 ranges.  For a 0-origin dimension of
    length n, these ranges are:
      (A) wrap around [-n, -1], which are mapped to [0, n-1] by adding n.
      (B) ordinary [0, n-1]
      (C) overreach [n, infinity], which effectively specify offsets in
              subsequent dimensions.  No index may overreach beyond the
              end of the entire array.
    All 3 ranges are supported for Range indices and scalar indices, but
    wrap around indexing is not supported for index lists.

    Note that a Range index or a rank-preserving range function (see
    range.c) always produces a 0-origin dimension in the result.
    A nil index or rubber index produces result dimension(s) with the
    same origin as the input array, and an index list produces result
    dimensions with origins copied from the index list dimensions.
 */
/*    Copyright (c) 1994.  The Regents of the University of California.
                    All rights reserved.  */

#include "ydata.h"

extern VMaction Eval2;
extern UnaryOp EvalAY, EvalLV;

extern Operand *FormOperandDB(Symbol *owner, Operand *op);

#define MAX_INDICES 10

/*
   For several types of DataBlock, the Eval operation means to index
   into an array.  This operation proceeds in several steps:

   1. ArrayDims
      Count the dummy indices, accumulating the corresponding strides.
      The result of this operation is the static values:
          nDummy       - number of dimensions in dummy dimension list
	  dims[]       - Dimension* for each dimension

   2. EvalSetup
      Scan through the actual indices to set:
          overreach   - 1 if any actual index beyond range of
                        corresponding dummy index
          overOrigin  - maximum origin of current actual index due to
                        overreach from previous actual indices
          offsets[]   - offset from beginning for each actual index
                        for rubber index, number of actual indices after,
                        for index list, -origin (so index values correct)
          numbers[]   - number of elements for each actual index
          steps[]     - index increments for each actual index
          rangeFlags[] - range->nilFlags for each actual index
          indexLists[] - index list for each actual index
	  Builder[]   - function to build result is one of
	     BuildScalar  - long scalar (offsets)
	     BuildList    - long array (offsets, indexLists)
	     BuildRange   - min:max:inc  or  rf:min:max:inc
                            (offsets, numbers, steps, rangeFlags)
             The arrays actually used by each Builder are shown in
             parentheses.  BuildRange also uses strides from step 1.

          rsltIndex    - index in result array for current actual index
          nRF          - number of range functions encountered
          rfs[]        - nRF range function pointers
          rfIndices[]  - index in result array for each range function
          markedIndex  - index in result array for marked index, or -1

          tmpDims      - Dimension list for result Array or LValue

      After all actual indices have been processed, EvalSetup checks
      for any overreach errors.

   3. ArrayStrides (called from BuildResult) or LValueStrides
      Compute the stride associated with each dummy index
	  strides[]    - stride (in bytes) for each dimension

   4. loop on BuildScalar, BuildList, BuildRange (from BuildResult or EvalLV)
      Process the indices from fastest to slowest varying.  The resulting
      LValue is built on the top of the stack by successive calls to the
      Builder routines set in step 2.

   5. DoRangeFuncs (called from BuildResult)
      Apply any range functions.  If the LValue produced in (3) is
      disk data, it is gathered before further processing.

   6. (end of BuildResult)
      Push number of marked index onto stack after result, if any.
      This is a special form used by the matrix multiply routines.
 */

extern void FormEvalOp(int nArgs, Operand *obj);
extern DataBlock *ForceToDB(Symbol *s);

static int EvalSetup(Symbol *stack, int n);
static void SetupScalar(long index);
static void DotdotScan(Symbol *stack, int singleIndex);
static void ArrayDims(Dimension *adims);
static void ArrayStrides(long stride);
static int LValueStrides(Strider *strider);
static void DoRangeFuncs(Array *array);
static void BuildResult(char *mem, StructDef *base,
			Array *array, Symbol *stack, int n);

/*--------------------------------------------------------------------------*/

/* current dummy and actual indices */
static int iDummy, iActual;

/* Characteristics of dummy indices (MAX_INDICES==nDummy) */
static int nDummy;
static Dimension *dims[MAX_INDICES];     /* dummy dimensions, fastest 1st */
static long strides[MAX_INDICES];        /* strides for dummy dimensions */

/* Characteristics of actual indices (MAX_INDICES==nActual) */
static int overreach;
static long overOrigin;                  /* maximum origin if overreach */
static long offsets[MAX_INDICES];        /* offsets for actual indices
					    used by scalars, ranges -- also
					    index count for rubber index */
static long numbers[MAX_INDICES];        /* numbers for actual indices */
static long steps[MAX_INDICES];          /* ::steps for actual indices */
static int rangeFlags[MAX_INDICES];      /* nilFlags for actual indices */
static Array *indexLists[MAX_INDICES];   /* index lists for actual indices */
static long (*Builder[MAX_INDICES])(LValue *);
                                         /* routine to build result */

/* Characteristics of result */
static int rsltIndex, markedIndex, nRF, iRubber;
  /* in following arrays (MAX_INDICES==nRF) */
static RangeFunc *rfs[MAX_INDICES];      /* range functions */
static int rfIndices[MAX_INDICES];       /* index # for rfs */

/* possible functions for Builder */
static long BuildScalar(LValue *result);
static long BuildList(LValue *result);
static long BuildRange(LValue *result);

/* set up function tables for initializing Builder and bParam arrays */

extern UnaryOp SetupC, SetupS, SetupI, SetupL, SetupX, SetupR, SetupVD;
extern UnaryOp ToLongC, ToLongS, ToLongI;

/*--------------------------------------------------------------------------*/

static int EvalSetup(Symbol *stack, int n)
{
  Operand index;
  Dimension *tmp= tmpDims;
  if (n>MAX_INDICES) YError("too many array indices");

  /* Note: There is no point in freeing tmpDims until here, where it
     is needed again.  Until now, tmpDims is simply an extra reference
     to the Dimension* created in the previous Eval operation.  The
     amount of storage associated with tmpDims is miniscule, so even
     if this is the last remaining reference, the fact that it wasn't
     freed as soon as possible is unimportant.  */
  tmpDims= 0;
  FreeDimension(tmp);

  overreach= rsltIndex= nRF= 0;
  markedIndex= iRubber= -1;
  overOrigin= 0;

  /* sort through all of the actual indices, setting up Builder routines */
  iDummy= 0;
  for (iActual=0 ; iActual<n ; iActual++) {
    stack++;
    if (!stack->ops) YError("array index cannot be keyword");
    stack->ops->FormOperand(stack, &index);
    index.ops->Setup(&index);
    if (iDummy<0) { /* nullifier, e.g.- where(0) */
      Drop(n+1);
      PushDataBlock(Ref(&nilDB));
      return 1;
    }
  }
  if (iDummy<nDummy && n>0) {
    if (index.ops==&voidOps) {
      /* pick up all remaining dummy indices, just as if final index
	 had been .. instead of nil */
      long number= numbers[--iActual];
      long na= offsets[iActual];
      DotdotScan(stack, 0);
      rangeFlags[iActual]|= R_RUBBER;
      numbers[iActual]*= number;
      offsets[iActual++]+= na;
    } /* else, should check that there wasn't a nil index followed by
	 one or more pseudo index -- however, this error is rather
	 expensive to detect, and I'm omitting the check for now.  */
  }

  /* make sure any references beyond index bounds are kosher */
  if (overOrigin) {
    while (overOrigin && iDummy<nDummy) overOrigin/= dims[iDummy++]->number;
    if (overOrigin) YError("index overreach beyond array bounds");
  }

  return 0;
}

/*--------------------------------------------------------------------------*/
/* Three distinct DataBlock types for Index operation:
   longType, rangeType, and voidType.
   char, short, and int also legal, as is LValue.
   These routines set up the LValue Builder routines.  */

static void SetupScalar(long index)
{
  long number;
  if (iDummy<nDummy) {
    number= dims[iDummy]->number;
    index-= yForceOrigin? 1L : dims[iDummy]->origin;
  } else {
    number= 1;
    index-= 1L;
  }

  if (index<0 && (index+=number)<0) {    /* notice behavior when index<0 */
    YError("array index is too small");
  } else if (index+overOrigin>=number) {
    overreach= 1;
    overOrigin+= index;
  }
  if (overOrigin) overOrigin/= number;  /* origin for next index */

  Builder[iActual]= &BuildScalar;
  offsets[iActual]= index;

  iDummy++;
}

void SetupL(Operand *op)
{
  /* Scalar is simple index, dimensioned array is index list */
  if (!op->type.dims) {
    SetupScalar(((long *)op->value)[0]);
    return;

  } else {            /* index list */
    long i, n= op->type.number;
    long *il= op->value;
    long ilMin, ilMax;
    long number= dims[iDummy]->number;
    long origin= yForceOrigin? 1L : dims[iDummy]->origin;

    if (iDummy>=nDummy) YError("index list beyond final array index");

    Builder[iActual]= &BuildList;
    /* Since dims is non-0, we know that the op->owner is a dataBlockSym
       which points to an Array (any LValue has been fetched).  */
    indexLists[iActual]= (Array *)op->owner->value.db;
    if (indexLists[iActual]->ops==&lvalueOps) {
      indexLists[iActual]= FetchLValue(indexLists[iActual], op->owner);
      il= indexLists[iActual]->value.l;
    }
    offsets[iActual]= -origin;  /* compensate for non-0 origin */
    iDummy++;

    /* find minimum and maximum index list values */
    ilMin= ilMax= il[0];
    for (i=1 ; i<n ; i++) {
      if (ilMin > il[i]) ilMin= il[i];
      else if (ilMax < il[i]) ilMax= il[i];
    }
    if (ilMin<origin) {
      YError("minimum array index in index list is too small");
    } else if (ilMax-origin+overOrigin>=number) {
      overreach= 1;
      overOrigin+= ilMax-origin;
    }
    if (overOrigin) overOrigin/= number;

    /* copy dimension list from index list to tmpDims (copy origins) */
    if (tmpDims) tmpDims= CopyDims(op->type.dims, tmpDims, 1);
    else tmpDims= Ref(op->type.dims);

    /* increment count of result indices */
    rsltIndex+= CountDims(op->type.dims);
    return;
  }
}

void SetupR(Operand *op)
{
  /* Range functions specify several cases:
     -:   this is not an actual index
     ..:  expand to fill remaining indices
     +:   mark this index  */
  Range *range= op->value;
  int nilFlags= range->nilFlags;
  long offset, origin, number, step, largest, n;

  /* Return iDummy==-1 to force void result before any Builders called.  */
  if (nilFlags & R_NULLER) { iDummy= -1;  return; }

  Builder[iActual]= &BuildRange;
  rangeFlags[iActual]= nilFlags;

  if (nilFlags & R_RUBBER) {
    DotdotScan(op->owner, nilFlags&R_PSEUDO);
    return;
  }

  /* set origin and n for dummy index corresponding to this actual index */
  step= range->inc;
  if (nilFlags & R_PSEUDO) {
    origin= step>0? range->min : range->max;
    n= 1;
    /* iDummy NOT incremented on this branch */
  } else {
    if (iDummy>=nDummy) YError("index range beyond final array index");
    origin= yForceOrigin? 1L : dims[iDummy]->origin;
    n= dims[iDummy]->number;
    if (nilFlags & R_MARKED) markedIndex= rsltIndex;
    iDummy++;
  }

  /* get min:max:inc and compensate for dummy origin */
  if (nilFlags&R_MINNIL) offset= step>0? 0 : n-1;
  else offset= range->min - origin;
  if (nilFlags&R_MAXNIL) number= step>0? n-1 : 0;
  else number= range->max - origin;

  /* perform negative index wrap around if necessary */
  if (offset<0 && (offset+=n)<0) {
    YError("array index range start is too small");
  } else if (number<0 && (number+=n)<0) {
    YError("array index range stop is too small");
  }

  /* compute the number of footprints (#strides+1) */
  if (step>=0 && number>=offset) {
    if (step>1) {
      largest= (number-offset)/step;
      number= largest+1;
      largest= offset + largest*step;
    } else {
      largest= number;
      number= number-offset+1;
    }
  } else if (step<0 && offset>=number) {
    if (step<-1) number= (offset-number)/(-step) + 1;
    else number= offset-number + 1;
    largest= offset;
  } else {
    YError("array index range step has wrong sign");
    largest= 0;
  }

  /* detect and handle overreach */
  if (largest+overOrigin>=n && (nilFlags&R_PSEUDO)==0) {
    overreach= 1;
    overOrigin+= largest;
  }
  if (overOrigin) overOrigin/= n;

  offsets[iActual]= offset;
  numbers[iActual]= number;
  steps[iActual]= step;

  tmpDims= NewDimension(number, 1L, tmpDims);  /* default origin */

  if (range->rf) {
    rfs[nRF]= range->rf;
    rfIndices[nRF++]= rsltIndex;
  }
  rsltIndex++;
}

static void DotdotScan(Symbol *stack, int singleIndex)
{
  /* Scan through remaining actual indices to see how many dummy
     indices to skip.  We only need to detect pseudo-indices, since
     these are the only type which break the one-one correspondence
     between actual and dummy indices.  */
  int na= 0;			/* # remaining non-pseudo actuals */
  long number, n;

  while (stack<sp) {
    stack++;
    if (stack->ops==&referenceSym) ReplaceRef(stack);
    if (stack->ops!=&dataBlockSym || stack->value.db->ops!=&rangeOps) {
      na++;
    } else {
      int nilFlags= ((Range *)stack->value.db)->nilFlags;
      if (nilFlags & R_RUBBER)
	YError("multiple rubber (.. or *) indices in one index list");
      if ((nilFlags & R_PSEUDO)==0) na++;
    }
  }

  if (singleIndex && (iDummy<nDummy-na-1)) iRubber= iActual;
  offsets[iActual]= na;		/* offset is actually 0, intentionally
				   misused here and in BuildRange */
  number= 1;
  while (iDummy < nDummy-na) {
    n= dims[iDummy]->number;
    if (overOrigin) overOrigin/= n;
    number*= n;
    /* copy origin here */
    if (!singleIndex)
      tmpDims= NewDimension(n, dims[iDummy]->origin, tmpDims);
    rsltIndex++;
    iDummy++;
  }
  if (singleIndex) tmpDims= NewDimension(number, 1L, tmpDims);
  numbers[iActual]= number;
  steps[iActual]= 1;
  return;
}

void SetupC(Operand *op)
{
  if (!op->type.dims) {
    SetupScalar((long)((char *)op->value)[0]);
  } else {
    ToLongC(op);
    SetupL(FormOperandDB(op->owner, op));
  }
}

void SetupS(Operand *op)
{
  if (!op->type.dims) {
    SetupScalar((long)((short *)op->value)[0]);
  } else {
    ToLongS(op);
    SetupL(FormOperandDB(op->owner, op));
  }
}

void SetupI(Operand *op)
{
  if (!op->type.dims) {
    SetupScalar((long)((int *)op->value)[0]);
  } else {
    ToLongI(op);
    SetupL(FormOperandDB(op->owner, op));
  }
}

/* ARGSUSED */
void SetupVD(Operand *op)
{
  long n= iDummy<nDummy? dims[iDummy]->number : 1L;
  Builder[iActual]= &BuildRange;
  rangeFlags[iActual]= 0;
  offsets[iActual]= 0;
  numbers[iActual]= n;
  steps[iActual]= 1;
  if (overOrigin) overOrigin= (overOrigin+n-1)/n;
  if (iDummy<nDummy) {
    tmpDims= NewDimension(n, dims[iDummy]->origin, tmpDims);
    rsltIndex++;
  }
  iDummy++;
}

/* ARGSUSED */
void SetupX(Operand *op)
{
  YError("bad data type for array index");
}

/*--------------------------------------------------------------------------*/
/* ArrayDims initializes dims[] and nDummy, ArrayStrides and LValueStrides
   initialize strides[].  */

static void ArrayDims(Dimension *adims)
{ /* ArrayDims(lvalue->type.dims); */
  if (!adims) {                  /* halt recursion */
    nDummy= 0;
    return;
  }
  ArrayDims(adims->next);              /* recurse */
  if (nDummy>=MAX_INDICES) YError("too many array dimensions");
  dims[nDummy++]= adims;
}

static void ArrayStrides(long stride)
{ /* ArrayDims(array->type.dims);  ArrayStrides(array->type.base->size); */
  int i;
  for (i=0 ; i<nDummy ; i++) {
    strides[i]= stride;
    stride*= dims[i]->number;
  }
}

static int LValueStrides(Strider *strider)
{ /* ArrayDims(lvalue->type.dims);  LValueStrides(lvalue->strider); */
  int iDummy;
  if (!strider) {                    /* halt recursion */
    iDummy= 0;

  } else {
    long n, number= strider->number;
    long stride= strider->stride;

    iDummy= LValueStrides(strider->next);  /* recurse */
    if (iDummy<0 || strider->indexList) return -1;

    if (iDummy<nDummy) {
      strides[iDummy]= stride;
      n= dims[iDummy++]->number;
      while (n<number) {
	strides[iDummy]= stride*n;
	n*= dims[iDummy++]->number;
      }
    }
  }
  return iDummy;
}

/*--------------------------------------------------------------------------*/
/* The Builder routines actually build up the result LValue.  */

static long BuildScalar(LValue *result)
{
  long offset= offsets[iActual] * strides[iDummy];
  iDummy++;
  return offset;
}

static long BuildRange(LValue *result)
{
  int nilFlags= rangeFlags[iActual];
  long offset, stride, number= numbers[iActual];

  /* Compute appropriate stride, offset, and increment iDummy */
  if (nilFlags&R_RUBBER) {   /* this is .. index (right justify remaining) */
    int na= offsets[iActual];       /* # remaining non-pseudo actuals */
    if (iDummy >= nDummy-na) return 0;
    if (number>1 && (iDummy<nDummy-na-1) && !(nilFlags&R_PSEUDO)) {
      /* a .. rubber index may need several striders */
      Strider *strider= result->strider;
      long n= 1, total= number;
      for (; iDummy<nDummy-na ; iDummy++) {
	if (n<total) {
	  stride= strides[iDummy];
	  number= dims[iDummy]->number;
	  if (number>1) {  /* (See comments below.) */
	    if (strider) {
	      if (!strider->indexList &&
		  strider->stride*strider->number == stride) {
		strider->number*= number;
	      } else {
		result->strider= NewStrider(stride, number);
		result->strider->next= strider;
		strider= result->strider;
	      }
	    } else {
	      result->strider= strider= NewStrider(stride, number);
	    }
	    n*= number;
	  }
	}
      }
      return 0;

    } else {
      stride= strides[iDummy];        /* steps[iActual] always 1 */
      offset= 0;
      iDummy= nDummy-na;
    }

  } else {
    if (nilFlags&R_PSEUDO) { /* this is - index (insert new dimension) */
      stride= offset= 0;

    } else {                 /* this is ordinary rf:min:max:inc */
      stride= steps[iActual] * strides[iDummy];
      offset= offsets[iActual] * strides[iDummy];
      iDummy++;
    }
  }

  /* Add or append to result->strider */
  if (number>1) {
    if (result->strider) {
      Strider *strider= result->strider;
      if (!strider->indexList &&
	  strider->stride*strider->number == stride) {
	/* If the current strider is not an index list, and its total
	   span (stride*number) is the same as the current stride, then
	   we can simply increment its number to include the current
	   dimension.  */
	strider->number*= number;
      } else {
	/* Otherwise, we need a new strider.  */
	result->strider= NewStrider(stride, number);
	result->strider->next= strider;
      }

    } else {
      result->strider= NewStrider(stride, number);
    }
  }

  return offset;
}

static long BuildList(LValue *result)
{
  Array *array= indexLists[iActual];
  long offset= offsets[iActual] * strides[iDummy];
  Strider *newStrider, *strider= result->strider;

  /* Add index list strider to result->strider */
  newStrider=
    result->strider= NewStrider(strides[iDummy], array->type.number);
  newStrider->next= strider;
  newStrider->indexList= Ref(array);

  iDummy++;
  return offset;
}

/*--------------------------------------------------------------------------*/

static void DoRangeFuncs(Array *array)
{
  /* Range functions are performed in left-to-right order, that is,
     from the fastest varying index to the slowest.  */
  int i, j;
  for (i=0 ; i<nRF ; i++) {
    if (rfs[i](array, rfIndices[i])) {
      /* This was a rank reducing operation, adjust the index numbering
	 for any remaining range functions.  */
      for (j=i+1 ; j<nRF ; j++) rfIndices[j]--;
      /* Note: parser responsible for ensuring that range->rf==0
	 whenever range->nilFlags&R_MARKED */
      if (markedIndex>i) markedIndex--;
    }
    /* range function left result on top of stack */
    sp--;
    sp->value= (sp+1)->value;
    sp->ops= (sp+1)->ops;
    Unref(array);
    array= (Array *)sp->value.db;
  }
}

static void BuildResult(char *mem, StructDef *base,
			Array *array, Symbol *stack, int n)
{
  LValue *result= PushDataBlock(NewLValueM(array, mem, base, tmpDims));

  /* build an appropriate LValue on top of stack */
  ArrayStrides(base->size);
  iDummy= 0;
  for (iActual=0 ; iActual<n ; iActual++) mem+= Builder[iActual](result);
  result->address.m= mem;

  /* swap result LValue with array on stack */
  PopTo(stack);     /* note that result owns use of array */

  /* discard actual indices */
  Drop(n);

  /* If range functions were specified, do them now.
     If the original array is a temporary, or if an index is marked,
     may as well fetch the result LValue now, and leave an Array on
     the stack instead.  Non-temporaries should be left as they are,
     since they might be destined for further indexing.  */
  if (nRF)
    DoRangeFuncs(FetchLValue(result, stack));
  else if (array->references==0 || markedIndex>=0)
    FetchLValue(result, stack);
}

/*--------------------------------------------------------------------------*/

void FormEvalOp(int nArgs, Operand *obj)
{
  Symbol *s= sp-nArgs;
  DataBlock *db= (s->ops==&dataBlockSym)? s->value.db : ForceToDB(s);
  obj->owner= s;
  obj->references= nArgs;   /* intentionally misused */
  obj->ops= db->ops;
  obj->value= db;
}

void Eval2(void)
{
  int nArgs= (pc++)->count;
  Operand obj;
  FormEvalOp(nArgs, &obj);

  /* guard against x(+)*y(+) where x or y is a function */
  if (!obj.ops->isArray && obj.ops!=&lvalueOps)
    YError("matrix multiply index marker (+) not in array index list");

  obj.ops->Eval(&obj);
  /* One index MUST be marked; Eval2 leaves 2 elements on the top of the
     stack-- the Array, and an intScalar to tell which index is marked.
     The parser guarantees that markedIndex>0 here, but only here.  */
  PushIntValue(markedIndex);
}

void EvalAY(Operand *op)
{
  Symbol *stack= op->owner;
  int nArgs= op->references;    /* interpret misuse in FormEvalOp */
  Array *array= op->value;

  /* initialize nDummy, dims, strides */
  ArrayDims(array->type.dims);

  /* initialize Builder, offsets, numbers, steps, indexLists, rfs, nRF */
  if (EvalSetup(stack, nArgs)) return;  /* nullifier index */

  BuildResult(array->value.c, array->type.base, array, stack, nArgs);
}

void EvalLV(Operand *op)
{
  Symbol *stack= op->owner;
  int nArgs= op->references;    /* interpret misuse in FormEvalOp */
  LValue *lvalue= op->value;
  Strider *strider= lvalue->strider;
  StructDef *base= lvalue->type.base;
  int addressType= base->addressType;

  /* initialize nDummy, dims */
  ArrayDims(lvalue->type.dims);

  /* initialize Builder, offsets, numbers, steps, indexLists, rfs, nRF */
  if (EvalSetup(stack, nArgs)) return;  /* nullifier index */

  if (nRF || markedIndex>=0 || (overreach&&strider) ||
      LValueStrides(strider)<0 || addressType>1 || iRubber>=0) {
    /* Must gather the original LValue into a compact Array if any of
       the following conditions are met:
       (1) The actual indices include range functions (the range
           function will need the data immediately).
       (2) There is a marked index (the matrix multiply operation
           will need the data)
       (3) Any actual index overreached its corresponding dummy index,
           and the LValue has strides (the overreached elements will
	   not be at the expected address)
       (4) The original LValue includes an index list (some of the
           actual indices may require extracting a subset of the index
	   list, rather than a subset of the data array)
       (5) The original LValue references a sequential object in a
           disk file.
       (6) A rubber * index contracts two or more dimensions into one
       As soon as one of these conditions is met, gather the LValue and
       proceed as for an Array.  */
    Array *dst= FetchLValue(lvalue, stack);

    /* The new Array is guaranteed to have simple strides, but nDummy,
       dims, Builder, numbers, offsets, steps, etc. have not changed.  */
    BuildResult(dst->value.c, dst->type.base, dst, stack, nArgs);

  } else {
    /* The input LValue is described by a simple hierarchy of strides.
       The data itself need never be touched to build the result LValue.  */
    long totalOffset;
    LValue *result;

    result= PushDataBlock(addressType?
			  NewLValueD(lvalue->address.d, base, tmpDims) :
			  NewLValueM(lvalue->owner, lvalue->address.m,
				     base, tmpDims));

    if (!strider) ArrayStrides(base->size);
    /* build an appropriate LValue on top of stack */
    totalOffset= 0;
    iDummy= 0;
    for (iActual=0 ; iActual<nArgs ; iActual++)
      totalOffset+= Builder[iActual](result);
    if (addressType) result->address.d+= totalOffset;
    else result->address.m+= totalOffset;

    /* swap result LValue with array on stack */
    PopTo(stack);

    /* discard actual indices, leaving result on top of stack */
    Drop(nArgs);
  }
}

/*--------------------------------------------------------------------------*/