[R-pkg-devel] Solaris SPARC, Fortran, and logical errors?
Uwe Ligges
ligges at statistik.tu-dortmund.de
Thu Mar 16 11:49:49 CET 2017
On 15.03.2017 18:30, Ben Bolker wrote:
>
>
> On 17-03-15 11:09 AM, J C Nash wrote:
>> Possibly tangential, but has there been any effort to set up a Sparc
>> testbed? It
>> seems we could use a network-available (virtual?) machine, since this
>> platform is
>> often the unfortunate one. Unless, of course, there's a sunset date.
>>
>> For information, I mentioned SPARC at our local linux group, and
>> apparently there
>> are a couple of folk who have them running, but I didn't find out the
>> state of the
>> OS etc.
>>
>> JN
>
> The virtual machine platforms I know of (admittedly not a complete
> list!) only support Solaris on x86, e.g.
Yes, you cannot emulate a Sparc in an efficient way on an amd64 platform.
I take the opportunity to repeat why testing on *Sparc Solaris* gives
many benefits:
- this way we cover big- and little-endian platforms (i.e. for future
stability so that it works on what appear to be still esoteric such as
ARM based architectures or so)
- we cover one of the commercial unixes, i.e. we see
+ how stuff works on the the typically rather old toolchains
+ and what happens in on gnu/gcc-setups and how much GNUisms are used
Best,
Uwe Ligges
>
> https://community.oracle.com/thread/2569292
>
>
>
>>
>>
>> On 2017-03-15 10:40 AM, Avraham Adler wrote:
>>> Hello.
>>>
>>> The Delaporte package works properly on all R-core platforms except
>>> Solaris SPARC, where it compiles properly but fails a number of its
>>> tests [1]. Not having access to a SPARC testbed, I'm limited in what
>>> kind of diagnostics I can do. One thing I have noticed is that a lot
>>> of the failures occur when I am passing non-default logicals (like
>>> lower tail or log). For example, the first failure at that link is
>>> when "log = true" is supposed to be passed, but the SPARC answers are
>>> the unlogged values. Of the 22 failed tests, 12 of them pass logicals.
>>>
>>> I'll bring an example of how it is coded below, and if anyone
>>> recognizes where SPARC specifically goes wrong, I'd appreciate. I
>>> guess, if I absolutely had to, I could convert the logical to an
>>> integer in C and pass the integer to Fortran which should work even
>>> for SPARC, but I'd prefer not to if I could help it.
>>>
>>> Thank you,
>>>
>>> Avi
>>>
>>> [1] https://cran.r-project.org/web/checks/check_results_Delaporte.html
>>>
>>> *****Example Code*****
>>>
>>> R code:
>>>
>>> ddelap <- function(x, alpha, beta, lambda, log = FALSE){
>>> if(!is.double(x)) {storage.mode(x) <- 'double'}
>>> if(!is.double(alpha)) {storage.mode(alpha) <- 'double'}
>>> if(!is.double(beta)) {storage.mode(beta) <- 'double'}
>>> if(!is.double(lambda)) {storage.mode(lambda) <- 'double'}
>>> if(any(x > floor(x))) {
>>> warning("Non-integers passed to ddelap. These will have 0
>>> probability.")
>>> }
>>> .Call(ddelap_C, x, alpha, beta, lambda, log)
>>> }
>>>
>>> C code:
>>>
>>> void ddelap_f(double *x, int nx, double *a, int na, double *b, int nb,
>>> double *l, int nl,
>>> int *lg, double *ret);
>>>
>>> extern SEXP ddelap_C(SEXP x, SEXP alpha, SEXP beta, SEXP lambda, SEXP
>>> lg){
>>> const int nx = LENGTH(x);
>>> const int na = LENGTH(alpha);
>>> const int nb = LENGTH(beta);
>>> const int nl = LENGTH(lambda);
>>> SEXP ret;
>>> PROTECT(ret = allocVector(REALSXP, nx));
>>> ddelap_f(REAL(x), nx, REAL(alpha), na, REAL(beta), nb, REAL(lambda),
>>> nl, LOGICAL(lg), REAL(ret));
>>> UNPROTECT(1);
>>> return(ret);
>>> }
>>>
>>> Fortran: (not posting ddelap_f_s as that doesn't handle the logging)
>>>
>>> subroutine ddelap_f(x, nx, a, na, b, nb, l, nl, lg, pmfv) bind(C,
>>> name="ddelap_f")
>>>
>>> integer(kind = c_int), intent(in), value :: nx, na, nb, nl
>>> ! Sizes
>>> real(kind = c_double), intent(in), dimension(nx) :: x
>>> ! Observations
>>> real(kind = c_double), intent(out), dimension(nx):: pmfv
>>> ! Result
>>> real(kind = c_double), intent(in) :: a(na), b(nb),
>>> l(nl)! Parameters
>>> logical(kind = c_bool), intent(in) :: lg
>>> ! Log flag
>>> integer :: i
>>> ! Integer
>>>
>>> !$omp parallel do default(shared) private(i)
>>> do i = 1, nx
>>> if (x(i) > floor(x(i))) then
>>> pmfv(i) = ZERO
>>> else
>>> pmfv(i) = ddelap_f_s(x(i), a(mod(i - 1, na) + 1), &
>>> b(mod(i - 1, nb) + 1), l(mod(i -
>>> 1, nl) + 1))
>>> end if
>>> end do
>>> !$omp end parallel do
>>>
>>> if (lg) then
>>> pmfv = log(pmfv)
>>> end if
>>>
>>> end subroutine ddelap_f
>>>
>>> ______________________________________________
>>> R-package-devel at r-project.org mailing list
>>> https://stat.ethz.ch/mailman/listinfo/r-package-devel
>>>
>>
>> ______________________________________________
>> R-package-devel at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-package-devel
>
> ______________________________________________
> R-package-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-package-devel
>
More information about the R-package-devel
mailing list