[R-pkg-devel] Solaris SPARC, Fortran, and logical errors?

[Ben Bolker]

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.

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