+ }
+ break;
+ } else {
+ /* conformant array */
+ if (p1 == ptype) {
+ if (q != ctype) {
+ error("Conformant array parameters in the same specification must be the same type.");
+ goto conf_err;
+ }
+ } else {
+ if (classify(q) != TARY && classify(q) != TSTR) {
+ error("Array type required for var parameter %s of %s",p1->symbol,p->symbol);
+ goto conf_err;
+ }
+ /* check base type of array */
+ if (p2->type != q->type) {
+ error("Base type of array not identical to that of conformant array parameter %s of %s", p1->symbol, p->symbol);
+ goto conf_err;
+ }
+ if (p2->value[0] != q->value[0]) {
+ error("Subscript number mismatch on conformant array parameter %s of %s", p1->symbol, p->symbol);
+ /* Don't process array bounds & width */
+conf_err: if (p1->chain->type->class == CRANGE) {
+ d = p1->value[0];
+ for (i = 1; i <= d; i++) {
+ /* for each subscript, pass by
+ * bounds and width
+ */
+ p1 = p1->chain->chain->chain;
+ }
+ }
+ ptype = ctype = NLNIL;
+ chk = FALSE;
+ break;
+ }
+ /*
+ * Save array type for all parameters with same
+ * specification.
+ */
+ ctype = q;
+ ptype = p2;
+ /*
+ * If at end of conformant array list,
+ * get bounds.
+ */
+ if (p1->chain->type->class == CRANGE) {
+ /* check each subscript, put on stack */
+ d = ptype->value[0];
+ q = ctype;
+ for (i = 1; i <= d; i++) {
+ p1 = p1->chain;
+ q = q->chain;
+ if (incompat(q, p1->type, TR_NIL)){
+ error("Subscript type not conformable with parameter %s of %s", p1->symbol, p->symbol);
+ chk = FALSE;
+ break;
+ }
+ /* Put lower and upper bound & width */
+# ifdef OBJ
+ if (q->type->class == CRANGE) {
+ putcbnds(q->type);
+ } else {
+ put(2, width(p1->type) <= 2 ? O_CON2
+ : O_CON4, q->range[0]);
+ put(2, width(p1->type) <= 2 ? O_CON2
+ : O_CON4, q->range[1]);
+ put(2, width(p1->type) <= 2 ? O_CON2
+ : O_CON4, aryconst(ctype,i));
+ }
+# endif OBJ
+# ifdef PC
+ if (q->type->class == CRANGE) {
+ for (j = 1; j <= 3; j++) {
+ p2 = p->nptr[j];
+ putRV(p2->symbol, (p2->nl_block
+ & 037), p2->value[0],
+ p2->extra_flags,p2type(p2));
+ putop(PCC_CM, PCCT_INT);
+ }
+ } else {
+ putleaf(PCC_ICON, q->range[0], 0,PCCT_INT,0);
+ putop( PCC_CM , PCCT_INT );
+ putleaf(PCC_ICON, q->range[1], 0,PCCT_INT,0);
+ putop( PCC_CM , PCCT_INT );
+ putleaf(PCC_ICON,aryconst(ctype,i),0,PCCT_INT,0);
+ putop( PCC_CM , PCCT_INT );
+ }
+# endif PC
+ p1 = p1->chain->chain;
+ }
+ }
+ }