View | Details | Raw Unified | Return to bug 16932 | Differences between
and this patch

Collapse All | Expand All

(-)seq.c (-171 / +230 lines)
Lines 1-7 Link Here
1
/*
1
/*
2
 *  R : A Computer Language for Statistical Data Analysis
2
 *  R : A Computer Language for Statistical Data Analysis
3
 *  Copyright (C) 1995-1998  Robert Gentleman and Ross Ihaka
3
 *  Copyright (C) 1995-1998  Robert Gentleman and Ross Ihaka
4
 *  Copyright (C) 1998-2016  The R Core Team.
4
 *  Copyright (C) 1998-2017  The R Core Team.
5
 *
5
 *
6
 *  This program is free software; you can redistribute it and/or modify
6
 *  This program is free software; you can redistribute it and/or modify
7
 *  it under the terms of the GNU General Public License as published by
7
 *  it under the terms of the GNU General Public License as published by
Lines 175-197 Link Here
175
    return seq_colon(n1, n2, call);
175
    return seq_colon(n1, n2, call);
176
}
176
}
177
177
178
#define rep2_imp \
179
    switch (TYPEOF(s)) { \
180
    case LGLSXP: \
181
	for (i = 0; i < nc; i++) { \
182
/*	    if ((i+1) % ni == 0) R_CheckUserInterrupt();*/ \
183
	    for (j = 0; j < (R_xlen_t) it[i]; j++) \
184
		LOGICAL(a)[n++] = LOGICAL(s)[i]; \
185
	} \
186
	break; \
187
    case INTSXP: \
188
	for (i = 0; i < nc; i++) { \
189
/*	    if ((i+1) % ni == 0) R_CheckUserInterrupt();*/ \
190
	    for (j = 0; j < (R_xlen_t) it[i]; j++) \
191
		INTEGER(a)[n++] = INTEGER(s)[i]; \
192
	} \
193
	break; \
194
    case REALSXP: \
195
	for (i = 0; i < nc; i++) { \
196
/*	    if ((i+1) % ni == 0) R_CheckUserInterrupt();*/ \
197
	    for (j = 0; j < (R_xlen_t) it[i]; j++) \
198
		REAL(a)[n++] = REAL(s)[i]; \
199
	} \
200
	break; \
201
    case CPLXSXP: \
202
	for (i = 0; i < nc; i++) { \
203
/*	    if ((i+1) % ni == 0) R_CheckUserInterrupt();*/ \
204
	    for (j = 0; j < (R_xlen_t) it[i]; j++) \
205
		COMPLEX(a)[n++] = COMPLEX(s)[i]; \
206
	} \
207
	break; \
208
    case STRSXP: \
209
	for (i = 0; i < nc; i++) { \
210
/*	    if ((i+1) % ni == 0) R_CheckUserInterrupt();*/ \
211
	    for (j = 0; j < (R_xlen_t) it[i]; j++) \
212
		SET_STRING_ELT(a, n++, STRING_ELT(s, i)); \
213
	} \
214
	break; \
215
    case VECSXP: \
216
    case EXPRSXP: \
217
	for (i = 0; i < nc; i++) { \
218
/*	    if ((i+1) % ni == 0) R_CheckUserInterrupt();*/ \
219
	    SEXP elt = lazy_duplicate(VECTOR_ELT(s, i)); \
220
	    for (j = 0; j < (R_xlen_t) it[i]; j++) \
221
		SET_VECTOR_ELT(a, n++, elt); \
222
	    if (j > 1) SET_NAMED(elt, 2); \
223
	} \
224
	break; \
225
    case RAWSXP: \
226
	for (i = 0; i < nc; i++) { \
227
/*	    if ((i+1) % ni == 0) R_CheckUserInterrupt();*/ \
228
	    for (j = 0; j < (R_xlen_t) it[i]; j++) \
229
		RAW(a)[n++] = RAW(s)[i]; \
230
	} \
231
	break; \
232
    default: \
233
	UNIMPLEMENTED_TYPE("rep2", s); \
234
    }
235
178
/* rep.int(x, times) for a vector times */
236
/* rep.int(x, times) for a vector times */
179
static SEXP rep2(SEXP s, SEXP ncopy)
237
static SEXP rep2(SEXP s, SEXP ncopy)
180
{
238
{
181
    R_xlen_t i, na, nc, n;
239
    R_xlen_t i, na, nc, n, j;
182
    int j;
183
    SEXP a, t;
240
    SEXP a, t;
241
    double sna;
184
242
243
#ifdef LONG_VECTOR_SUPPORT
244
    if (TYPEOF(ncopy) != INTSXP)
245
#else
246
    if (TYPEOF(ncopy) == REALSXP)
247
#endif
248
    PROTECT(t = coerceVector(ncopy, REALSXP));
249
    else
185
    PROTECT(t = coerceVector(ncopy, INTSXP));
250
    PROTECT(t = coerceVector(ncopy, INTSXP));
186
251
187
    nc = xlength(ncopy);
252
    nc = xlength(ncopy);
188
    na = 0;
253
    sna = 0;
254
    if (TYPEOF(t) == REALSXP)
255
    for (i = 0; i < nc; i++) {
256
//	if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
257
	if (ISNAN(REAL(t)[i]) || REAL(t)[i] <= -1 ||
258
	    REAL(t)[i] >= R_XLEN_T_MAX+1.0)
259
	    error(_("invalid '%s' value"), "times");
260
	sna += (R_xlen_t) REAL(t)[i];
261
    }
262
    else
189
    for (i = 0; i < nc; i++) {
263
    for (i = 0; i < nc; i++) {
190
//	if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
264
//	if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
191
	if (INTEGER(t)[i] == NA_INTEGER || INTEGER(t)[i] < 0)
265
	if (INTEGER(t)[i] == NA_INTEGER || INTEGER(t)[i] < 0)
192
	    error(_("invalid '%s' value"), "times");
266
	    error(_("invalid '%s' value"), "times");
193
	na += INTEGER(t)[i];
267
	sna += INTEGER(t)[i];
194
    }
268
    }
269
    if (sna > R_XLEN_T_MAX)
270
	error(_("invalid '%s' value"), "times");
271
    na = (R_xlen_t) sna;
195
272
196
/*    R_xlen_t ni = NINTERRUPT, ratio;
273
/*    R_xlen_t ni = NINTERRUPT, ratio;
197
    if(nc > 0) {
274
    if(nc > 0) {
Lines 200-260 Link Here
200
	} */
277
	} */
201
    PROTECT(a = allocVector(TYPEOF(s), na));
278
    PROTECT(a = allocVector(TYPEOF(s), na));
202
    n = 0;
279
    n = 0;
203
    switch (TYPEOF(s)) {
280
    if (TYPEOF(t) == REALSXP) {
204
    case LGLSXP:
281
    double *it = REAL(t);
205
	for (i = 0; i < nc; i++) {
282
    rep2_imp
206
//	    if ((i+1) % ni == 0) R_CheckUserInterrupt();
283
    } else {
207
	    for (j = 0; j < INTEGER(t)[i]; j++)
284
    int *it = INTEGER(t);
208
		LOGICAL(a)[n++] = LOGICAL(s)[i];
285
    rep2_imp
209
	}
210
	break;
211
    case INTSXP:
212
	for (i = 0; i < nc; i++) {
213
//	    if ((i+1) % ni == 0) R_CheckUserInterrupt();
214
	    for (j = 0; j < INTEGER(t)[i]; j++)
215
		INTEGER(a)[n++] = INTEGER(s)[i];
216
	}
217
	break;
218
    case REALSXP:
219
	for (i = 0; i < nc; i++) {
220
//	    if ((i+1) % ni == 0) R_CheckUserInterrupt();
221
	    for (j = 0; j < INTEGER(t)[i]; j++)
222
		REAL(a)[n++] = REAL(s)[i];
223
	}
224
	break;
225
    case CPLXSXP:
226
	for (i = 0; i < nc; i++) {
227
//	    if ((i+1) % ni == 0) R_CheckUserInterrupt();
228
	    for (j = 0; j < INTEGER(t)[i]; j++)
229
		COMPLEX(a)[n++] = COMPLEX(s)[i];
230
	}
231
	break;
232
    case STRSXP:
233
	for (i = 0; i < nc; i++) {
234
//	    if ((i+1) % ni == 0) R_CheckUserInterrupt();
235
	    for (j = 0; j < INTEGER(t)[i]; j++)
236
		SET_STRING_ELT(a, n++, STRING_ELT(s, i));
237
	}
238
	break;
239
    case VECSXP:
240
    case EXPRSXP:
241
	for (i = 0; i < nc; i++) {
242
//	    if ((i+1) % ni == 0) R_CheckUserInterrupt();
243
	    SEXP elt = lazy_duplicate(VECTOR_ELT(s, i));
244
	    for (j = 0; j < INTEGER(t)[i]; j++)
245
		SET_VECTOR_ELT(a, n++, elt);
246
	    if (j > 1) SET_NAMED(elt, 2);
247
	}
248
	break;
249
    case RAWSXP:
250
	for (i = 0; i < nc; i++) {
251
//	    if ((i+1) % ni == 0) R_CheckUserInterrupt();
252
	    for (j = 0; j < INTEGER(t)[i]; j++)
253
		RAW(a)[n++] = RAW(s)[i];
254
	}
255
	break;
256
    default:
257
	UNIMPLEMENTED_TYPE("rep2", s);
258
    }
286
    }
259
    UNPROTECT(2);
287
    UNPROTECT(2);
260
    return a;
288
    return a;
Lines 339-354 Link Here
339
    else {
367
    else {
340
	if (nc != 1) error(_("invalid '%s' value"), "times");
368
	if (nc != 1) error(_("invalid '%s' value"), "times");
341
369
342
#ifdef LONG_VECTOR_SUPPORT
370
	R_xlen_t ns = xlength(s);
371
	if (TYPEOF(ncopy) != INTSXP) {
343
	double snc = asReal(ncopy);
372
	double snc = asReal(ncopy);
344
	if (!R_FINITE(snc) || snc < 0)
373
	if (!R_FINITE(snc) || snc <= -1 ||
374
	    (ns > 0 && snc >= R_XLEN_T_MAX+1.0))
345
	    error(_("invalid '%s' value"), "times");
375
	    error(_("invalid '%s' value"), "times");
346
	nc = (R_xlen_t) snc;
376
	nc = ns == 0 ? 1 : (R_xlen_t) snc;
347
#else
377
	} else
348
	if ((nc = asInteger(ncopy)) == NA_INTEGER || nc < 0)/* nc = 0 ok */
378
	if ((nc = asInteger(ncopy)) == NA_INTEGER || nc < 0)/* nc = 0 ok */
349
	    error(_("invalid '%s' value"), "times");
379
	    error(_("invalid '%s' value"), "times");
350
#endif
380
	if ((double) nc * ns > R_XLEN_T_MAX)
351
	R_xlen_t ns = xlength(s);
381
	    error(_("invalid '%s' value"), "times");
352
	PROTECT(a = rep3(s, ns, nc * ns));
382
	PROTECT(a = rep3(s, ns, nc * ns));
353
    }
383
    }
354
384
Lines 388-402 Link Here
388
    len = CADR(args);
418
    len = CADR(args);
389
    if(length(len) != 1)
419
    if(length(len) != 1)
390
	error(_("invalid '%s' value"), "length.out");
420
	error(_("invalid '%s' value"), "length.out");
391
#ifdef LONG_VECTOR_SUPPORT
421
    if (TYPEOF(len) != INTSXP) {
392
    double sna = asReal(len);
422
    double sna = asReal(len);
393
    if (!R_FINITE(sna) || sna < 0)
423
    if (ISNAN(sna) || sna <= -1 || sna >= R_XLEN_T_MAX+1.0)
394
	error(_("invalid '%s' value"), "length.out");
424
	error(_("invalid '%s' value"), "length.out");
395
    na = (R_xlen_t) sna;
425
    na = (R_xlen_t) sna;
396
#else
426
    } else
397
    if ((na = asInteger(len)) == NA_INTEGER || na < 0) /* na = 0 ok */
427
    if ((na = asInteger(len)) == NA_INTEGER || na < 0) /* na = 0 ok */
398
	error(_("invalid '%s' value"), "length.out");
428
	error(_("invalid '%s' value"), "length.out");
399
#endif
400
429
401
    if (TYPEOF(s) == NILSXP && na > 0)
430
    if (TYPEOF(s) == NILSXP && na > 0)
402
	error(_("cannot replicate NULL to a non-zero length"));
431
	error(_("cannot replicate NULL to a non-zero length"));
Lines 432-440 Link Here
432
    return a;
461
    return a;
433
}
462
}
434
463
464
#define rep4v_imp \
465
    switch (TYPEOF(x)) { \
466
    case LGLSXP: \
467
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) { \
468
/*		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();*/ \
469
		for(j = 0, sum = 0; j < each; j++) sum += (R_xlen_t) itimes[k++]; \
470
		for(k3 = 0; k3 < sum; k3++) { \
471
		    LOGICAL(a)[k2++] = LOGICAL(x)[i]; \
472
		    if(k2 == len) goto done; \
473
		} \
474
	    } \
475
	break; \
476
    case INTSXP: \
477
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) { \
478
/*		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();*/ \
479
		for(j = 0, sum = 0; j < each; j++) sum += (R_xlen_t) itimes[k++]; \
480
		for(k3 = 0; k3 < sum; k3++) { \
481
		    INTEGER(a)[k2++] = INTEGER(x)[i]; \
482
		    if(k2 == len) goto done; \
483
		} \
484
	    } \
485
	break; \
486
    case REALSXP: \
487
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) { \
488
/*		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();*/ \
489
		for(j = 0, sum = 0; j < each; j++) sum += (R_xlen_t) itimes[k++]; \
490
		for(k3 = 0; k3 < sum; k3++) { \
491
		    REAL(a)[k2++] = REAL(x)[i]; \
492
		    if(k2 == len) goto done; \
493
		} \
494
	    } \
495
	break; \
496
    case CPLXSXP: \
497
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) { \
498
/*		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();*/ \
499
		for(j = 0, sum = 0; j < each; j++) sum += (R_xlen_t) itimes[k++]; \
500
		for(k3 = 0; k3 < sum; k3++) { \
501
		    COMPLEX(a)[k2++] = COMPLEX(x)[i]; \
502
		    if(k2 == len) goto done; \
503
		} \
504
	    } \
505
	break; \
506
    case STRSXP: \
507
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) { \
508
/*		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();*/ \
509
		for(j = 0, sum = 0; j < each; j++) sum += (R_xlen_t) itimes[k++]; \
510
		for(k3 = 0; k3 < sum; k3++) { \
511
		    SET_STRING_ELT(a, k2++, STRING_ELT(x, i)); \
512
		    if(k2 == len) goto done; \
513
		} \
514
	    } \
515
	break; \
516
    case VECSXP: \
517
    case EXPRSXP: \
518
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) { \
519
/*		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();*/ \
520
		for(j = 0, sum = 0; j < each; j++) sum += (R_xlen_t) itimes[k++]; \
521
		for(k3 = 0; k3 < sum; k3++) { \
522
		    SET_VECTOR_ELT(a, k2++, VECTOR_ELT(x, i)); \
523
		    if(k2 == len) goto done; \
524
		} \
525
	    } \
526
	break; \
527
    case RAWSXP: \
528
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) { \
529
/*		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();*/ \
530
		for(j = 0, sum = 0; j < each; j++) sum += (R_xlen_t) itimes[k++]; \
531
		for(k3 = 0; k3 < sum; k3++) { \
532
		    RAW(a)[k2++] = RAW(x)[i]; \
533
		    if(k2 == len) goto done; \
534
		} \
535
	    } \
536
	break; \
537
    default: \
538
	UNIMPLEMENTED_TYPE("rep4", x); \
539
    }
540
435
/* rep(), allowing for both times and each ;
541
/* rep(), allowing for both times and each ;
436
 * -----  nt == length(times) ;  if (nt == 1)  'times' is *not* accessed  */
542
 * -----  nt == length(times) ;  if (nt == 1)  'times' is *not* accessed  */
437
static SEXP rep4(SEXP x, SEXP times, R_xlen_t len, int each, R_xlen_t nt)
543
static SEXP rep4(SEXP x, SEXP times, R_xlen_t len, R_xlen_t each, R_xlen_t nt)
438
{
544
{
439
    SEXP a;
545
    SEXP a;
440
    R_xlen_t lx = xlength(x);
546
    R_xlen_t lx = xlength(x);
Lines 445-574 Link Here
445
551
446
    PROTECT(a = allocVector(TYPEOF(x), len));
552
    PROTECT(a = allocVector(TYPEOF(x), len));
447
553
554
    if(nt == 1)
448
    switch (TYPEOF(x)) {
555
    switch (TYPEOF(x)) {
449
    case LGLSXP:
556
    case LGLSXP:
450
	if(nt == 1)
451
	    for(i = 0; i < len; i++) {
557
	    for(i = 0; i < len; i++) {
452
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
558
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
453
		LOGICAL(a)[i] = LOGICAL(x)[(i/each) % lx];
559
		LOGICAL(a)[i] = LOGICAL(x)[(i/each) % lx];
454
	    }
560
	    }
455
	else {
456
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) {
457
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
458
		for(j = 0, sum = 0; j < each; j++) sum += INTEGER(times)[k++];
459
		for(k3 = 0; k3 < sum; k3++) {
460
		    LOGICAL(a)[k2++] = LOGICAL(x)[i];
461
		    if(k2 == len) goto done;
462
		}
463
	    }
464
	}
465
	break;
561
	break;
466
    case INTSXP:
562
    case INTSXP:
467
	if(nt == 1)
468
	    for(i = 0; i < len; i++) {
563
	    for(i = 0; i < len; i++) {
469
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
564
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
470
		INTEGER(a)[i] = INTEGER(x)[(i/each) % lx];
565
		INTEGER(a)[i] = INTEGER(x)[(i/each) % lx];
471
	    }
566
	    }
472
	else {
473
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) {
474
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
475
		for(j = 0, sum = 0; j < each; j++) sum += INTEGER(times)[k++];
476
		for(k3 = 0; k3 < sum; k3++) {
477
		    INTEGER(a)[k2++] = INTEGER(x)[i];
478
		    if(k2 == len) goto done;
479
		}
480
	    }
481
	}
482
	break;
567
	break;
483
    case REALSXP:
568
    case REALSXP:
484
	if(nt == 1)
485
	    for(i = 0; i < len; i++) {
569
	    for(i = 0; i < len; i++) {
486
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
570
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
487
		REAL(a)[i] = REAL(x)[(i/each) % lx];
571
		REAL(a)[i] = REAL(x)[(i/each) % lx];
488
	    }
572
	    }
489
	else {
490
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) {
491
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
492
		for(j = 0, sum = 0; j < each; j++) sum += INTEGER(times)[k++];
493
		for(k3 = 0; k3 < sum; k3++) {
494
		    REAL(a)[k2++] = REAL(x)[i];
495
		    if(k2 == len) goto done;
496
		}
497
	    }
498
	}
499
	break;
573
	break;
500
    case CPLXSXP:
574
    case CPLXSXP:
501
	if(nt == 1)
502
	    for(i = 0; i < len; i++) {
575
	    for(i = 0; i < len; i++) {
503
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
576
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
504
		COMPLEX(a)[i] = COMPLEX(x)[(i/each) % lx];
577
		COMPLEX(a)[i] = COMPLEX(x)[(i/each) % lx];
505
	    }
578
	    }
506
	else {
507
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) {
508
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
509
		for(j = 0, sum = 0; j < each; j++) sum += INTEGER(times)[k++];
510
		for(k3 = 0; k3 < sum; k3++) {
511
		    COMPLEX(a)[k2++] = COMPLEX(x)[i];
512
		    if(k2 == len) goto done;
513
		}
514
	    }
515
	}
516
	break;
579
	break;
517
    case STRSXP:
580
    case STRSXP:
518
	if(nt == 1)
519
	    for(i = 0; i < len; i++) {
581
	    for(i = 0; i < len; i++) {
520
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
582
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
521
		SET_STRING_ELT(a, i, STRING_ELT(x, (i/each) % lx));
583
		SET_STRING_ELT(a, i, STRING_ELT(x, (i/each) % lx));
522
	    }
584
	    }
523
	else {
524
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) {
525
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
526
		for(j = 0, sum = 0; j < each; j++) sum += INTEGER(times)[k++];
527
		for(k3 = 0; k3 < sum; k3++) {
528
		    SET_STRING_ELT(a, k2++, STRING_ELT(x, i));
529
		    if(k2 == len) goto done;
530
		}
531
	    }
532
	}
533
	break;
585
	break;
534
    case VECSXP:
586
    case VECSXP:
535
    case EXPRSXP:
587
    case EXPRSXP:
536
	if(nt == 1)
537
	    for(i = 0; i < len; i++) {
588
	    for(i = 0; i < len; i++) {
538
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
589
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
539
		SET_VECTOR_ELT(a, i, VECTOR_ELT(x, (i/each) % lx));
590
		SET_VECTOR_ELT(a, i, VECTOR_ELT(x, (i/each) % lx));
540
	    }
591
	    }
541
	else {
542
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) {
543
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
544
		for(j = 0, sum = 0; j < each; j++) sum += INTEGER(times)[k++];
545
		for(k3 = 0; k3 < sum; k3++) {
546
		    SET_VECTOR_ELT(a, k2++, VECTOR_ELT(x, i));
547
		    if(k2 == len) goto done;
548
		}
549
	    }
550
	}
551
	break;
592
	break;
552
    case RAWSXP:
593
    case RAWSXP:
553
	if(nt == 1)
554
	    for(i = 0; i < len; i++) {
594
	    for(i = 0; i < len; i++) {
555
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
595
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
556
		RAW(a)[i] = RAW(x)[(i/each) % lx];
596
		RAW(a)[i] = RAW(x)[(i/each) % lx];
557
	    }
597
	    }
558
	else {
559
	    for(i = 0, k = 0, k2 = 0; i < lx; i++) {
560
//		if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
561
		for(j = 0, sum = 0; j < each; j++) sum += INTEGER(times)[k++];
562
		for(k3 = 0; k3 < sum; k3++) {
563
		    RAW(a)[k2++] = RAW(x)[i];
564
		    if(k2 == len) goto done;
565
		}
566
	    }
567
	}
568
	break;
598
	break;
569
    default:
599
    default:
570
	UNIMPLEMENTED_TYPE("rep4", x);
600
	UNIMPLEMENTED_TYPE("rep4", x);
571
    }
601
    }
602
    else if(TYPEOF(times) == REALSXP) {
603
    double *itimes = REAL(times);
604
    rep4v_imp
605
    } else {
606
    int *itimes = INTEGER(times);
607
    rep4v_imp
608
    }
572
done:
609
done:
573
    UNPROTECT(1);
610
    UNPROTECT(1);
574
    return a;
611
    return a;
Lines 582-589 Link Here
582
SEXP attribute_hidden do_rep(SEXP call, SEXP op, SEXP args, SEXP rho)
619
SEXP attribute_hidden do_rep(SEXP call, SEXP op, SEXP args, SEXP rho)
583
{
620
{
584
    SEXP ans, x, times = R_NilValue;
621
    SEXP ans, x, times = R_NilValue;
585
    int each = 1, nprotect = 3;
622
    int nprotect = 3;
586
    R_xlen_t i, lx, len = NA_INTEGER, nt;
623
    R_xlen_t i, lx, len = NA_INTEGER, each = 1, nt;
587
    static SEXP do_rep_formals = NULL;
624
    static SEXP do_rep_formals = NULL;
588
625
589
    /* includes factors, POSIX[cl]t, Date */
626
    /* includes factors, POSIX[cl]t, Date */
Lines 610-620 Link Here
610
647
611
    lx = xlength(x);
648
    lx = xlength(x);
612
649
650
    if (TYPEOF(CADDR(args)) != INTSXP) {
613
    double slen = asReal(CADDR(args));
651
    double slen = asReal(CADDR(args));
614
    if (R_FINITE(slen)) {
652
    if (R_FINITE(slen)) {
615
	if(slen < 0)
653
	if (slen <= -1 || slen >= R_XLEN_T_MAX+1.0)
616
	    errorcall(call, _("invalid '%s' argument"), "length.out");
654
	    errorcall(call, _("invalid '%s' argument"), "length.out");
617
	len = (R_xlen_t) slen;
655
	len = (R_xlen_t) slen;
656
    } else len = NA_INTEGER;
618
    } else {
657
    } else {
619
	len = asInteger(CADDR(args));
658
	len = asInteger(CADDR(args));
620
	if(len != NA_INTEGER && len < 0)
659
	if(len != NA_INTEGER && len < 0)
Lines 624-632 Link Here
624
	warningcall(call, _("first element used of '%s' argument"),
663
	warningcall(call, _("first element used of '%s' argument"),
625
		    "length.out");
664
		    "length.out");
626
665
666
    if (TYPEOF(CADDDR(args)) != INTSXP) {
667
    double seach = asReal(CADDDR(args));
668
    if (R_FINITE(seach)) {
669
    if (seach <= -1 || (lx > 0 && seach >= R_XLEN_T_MAX+1.0))
670
	errorcall(call, _("invalid '%s' argument"), "each");
671
    each = lx == 0 ? NA_INTEGER : (R_xlen_t) seach;
672
    } else each = NA_INTEGER;
673
    } else {
627
    each = asInteger(CADDDR(args));
674
    each = asInteger(CADDDR(args));
628
    if(each != NA_INTEGER && each < 0)
675
    if(each != NA_INTEGER && each < 0)
629
	errorcall(call, _("invalid '%s' argument"), "each");
676
	errorcall(call, _("invalid '%s' argument"), "each");
677
    }
630
    if(length(CADDDR(args)) != 1)
678
    if(length(CADDDR(args)) != 1)
631
	warningcall(call, _("first element used of '%s' argument"), "each");
679
	warningcall(call, _("first element used of '%s' argument"), "each");
632
    if(each == NA_INTEGER) each = 1;
680
    if(each == NA_INTEGER) each = 1;
Lines 651-691 Link Here
651
    if(len != NA_INTEGER) { /* takes precedence over times */
699
    if(len != NA_INTEGER) { /* takes precedence over times */
652
	nt = 1;
700
	nt = 1;
653
    } else {
701
    } else {
654
	R_xlen_t sum = 0;
702
	double sum = 0;
655
	nt = CADR(args) == R_MissingArg ? 1 : XLENGTH(CADR(args));
703
	if(CADR(args) == R_MissingArg) PROTECT(times = ScalarInteger(1));
704
#ifdef LONG_VECTOR_SUPPORT
705
	else if(TYPEOF(CADR(args)) != INTSXP)
706
#else
707
	else if(TYPEOF(CADR(args)) == REALSXP)
708
#endif
709
	    PROTECT(times = coerceVector(CADR(args), REALSXP));
710
	else PROTECT(times = coerceVector(CADR(args), INTSXP));
711
	nprotect++;
712
	nt = XLENGTH(times);
656
	if(nt == 1) {
713
	if(nt == 1) {
657
	    R_xlen_t it;
714
	    R_xlen_t it;
658
	    if(CADR(args) == R_MissingArg) it = 1; else {
715
	    if (TYPEOF(times) == REALSXP) {
659
		if(!isVectorAtomic(CADR(args))) {
716
		double rt = REAL(times)[0];
660
		    warningcall(call, _("'%s' is not an atomic vector.  This is deprecated."),
717
		if (ISNAN(rt) || rt <= -1 || rt >= R_XLEN_T_MAX+1.0)
661
				"times");
662
		    PROTECT(times = coerceVector(CADR(args), REALSXP)); nprotect++;
663
		} else times = CADR(args);
664
#ifdef LONG_VECTOR_SUPPORT
665
		double rt = asReal(times); // asReal(CADR(args));
666
		if (!R_FINITE(rt) || rt < 0)
667
		    errorcall(call, _("invalid '%s' argument"), "times");
718
		    errorcall(call, _("invalid '%s' argument"), "times");
668
		it = (R_xlen_t) rt;
719
		it = (R_xlen_t) rt;
669
#else
720
	    } else {
670
		it = asInteger(times); // asInteger(CADR(args));
721
		it = INTEGER(times)[0];
671
		if (it == NA_INTEGER || it < 0)
722
		if (it == NA_INTEGER || it < 0)
672
		    errorcall(call, _("invalid '%s' argument"), "times");
723
		    errorcall(call, _("invalid '%s' argument"), "times");
673
#endif
674
	    }
724
	    }
725
	    if ((double) lx * it * each > R_XLEN_T_MAX)
726
		errorcall(call, _("invalid '%s' argument"), "times");
675
	    len = lx * it * each;
727
	    len = lx * it * each;
676
	} else { // nt != 1 -- only for this case 'times' is accessed, here and in rep4()
728
	} else { // nt != 1
677
	    if(nt != lx * each)
729
	    if(nt != (double) lx * each)
678
		errorcall(call, _("invalid '%s' argument"), "times");
730
		errorcall(call, _("invalid '%s' argument"), "times");
679
	    // FIXME: 1. allow large int., i.e. REALSXP; would need even more changes in rep4()
731
	    if (TYPEOF(times) == REALSXP)
680
	    //        2. this does still work with  list(1,2) [which should be deprecated]
732
	    for(i = 0; i < nt; i++) {
681
	    PROTECT(times = coerceVector(CADR(args), INTSXP)); nprotect++;
733
		double rt = REAL(times)[i];
734
		if (ISNAN(rt) || rt <= -1 || rt >= R_XLEN_T_MAX+1.0)
735
		    errorcall(call, _("invalid '%s' argument"), "times");
736
		sum += (R_xlen_t) rt;
737
	    }
738
	    else
682
	    for(i = 0; i < nt; i++) {
739
	    for(i = 0; i < nt; i++) {
683
		int it = INTEGER(times)[i];
740
		int it = INTEGER(times)[i];
684
		if (it == NA_INTEGER || it < 0)
741
		if (it == NA_INTEGER || it < 0)
685
		    errorcall(call, _("invalid '%s' argument"), "times");
742
		    errorcall(call, _("invalid '%s' argument"), "times");
686
		sum += it;
743
		sum += it;
687
	    }
744
	    }
688
	    len = sum;
745
	    if (sum > R_XLEN_T_MAX)
746
		errorcall(call, _("invalid '%s' argument"), "times");
747
	    len = (R_xlen_t) sum;
689
	}
748
	}
690
    }
749
    }
691
750

Return to bug 16932