WIP

client/rsh/inst/benchmarks/RealThing/convolution.R

@@ -0,0 +1,24 @@
+execute <- function(n=500) {
+
+  convolve <- function(a, b) # from the extending R manual
+  {
+      a <- as.double(a)
+      b <- as.double(b)
+      na <- length(a)
+      nb <- length(b)
+      ab <- double(na + nb)
+      for(i in 1 : na)
+          for(j in 1 : nb)
+              ab[i + j] <- ab[i + j] + a[i] * b[j]
+      ab
+  }
+
+  a <- 1:n
+  b <- 1:n
+  checksum <- 0
+  for (i in 1:10) {
+    checksum <- checksum + convolve(a,b)[[n]]
+  }
+  # cat("Convolution ", n, " " , checksum, ": ")
+  checksum
+}

client/rsh/inst/benchmarks/RealThing/convolution_slow.R

@@ -0,0 +1,24 @@
+convolveSlow <- function(x,y) {
+  nx <- length(x)
+  ny <- length(y)
+  z <- numeric(nx + ny - 1)
+  for(i in seq(length = nx)) {
+    xi <- x[[i]]
+    for(j in seq(length = ny)) {
+      ij <- i + j - 1
+      z[[ij]] <- z[[ij]] + xi * y[[j]]
+    }
+  }
+  z
+}
+
+execute <- function(n=1500) {
+  a <- 1:n
+  b <- 1:n
+  checksum <- 0
+  for (i in 1:10) {
+    checksum <- checksum + convolveSlow(a,b)[[n]]
+  }
+  # cat("Convolution ", n, " " , checksum, ": ")
+  checksum
+}

client/rsh/inst/benchmarks/RealThing/convolution_v.R

@@ -0,0 +1,20 @@
+convolveV <- function(x, y) {
+  nx <- length(x)
+  ny <- length(y)
+  xy <- rbind(outer(x,y), matrix(0, nx, ny))
+  nxy <- nx + ny - 1
+  length(xy) <- nxy * ny
+  dim(xy) <- c(nxy, ny)
+  rowSums(xy)
+}
+
+execute <- function(n=1000) {
+  a <- 1:n
+  b <- 1:n
+  checksum <- 0
+  for (i in 1:10) {
+    checksum <- checksum + convolveV(a,b)[[n]]
+  }
+  # cat("Convolution ", n, " " , checksum, ": ")
+  checksum
+}

client/rsh/inst/benchmarks/RealThing/volcano.R

@@ -0,0 +1,78 @@
+execute <- function(n=1) {
+
+  bench_rays <- function(height.map = volcano, sun.angle = 45) {
+      shadow <- matrix(1, ncol = ncol(height.map), nrow = nrow(height.map))
+      sunangle <- sun.angle / 180 * pi
+      angle <- -90 / 180 * pi
+      diffangle <- 90 / 180 * pi
+      numberangles <- 25
+      # anglebreaks <- seq(angle, diffangle, length.out = numberangles)
+      anglebreaks <- sapply(seq(angle, diffangle, length.out = numberangles), tan)
+      maxdistance <- floor(sqrt(ncol(height.map)^2 + nrow(height.map)^2))
+      sinsun <- sin(sunangle)
+      cossun <- cos(sunangle)
+
+      for (i in 1:nrow(height.map)) {
+          for (j in 1:ncol(height.map)) {
+              for (anglei in anglebreaks) {
+                  for (k in 1:maxdistance) {
+                      # xcoord <- i + sin(sunangle) * k
+                      xcoord <- i + sinsun * k
+                      # ycoord <- j + cos(sunangle) * k
+                      ycoord <- j + cossun * k
+
+                      if (xcoord > nrow(height.map) ||
+                          ycoord > ncol(height.map) ||
+                          xcoord < 0 || ycoord < 0) break
+
+                      # tanangheight <- height.map[i, j] + tan(anglei) * k
+                      tanangheight <- height.map[i, j] + anglei * k
+
+                      if (all(c(height.map[ceiling(xcoord), ceiling(ycoord)],
+                                height.map[floor(xcoord),   ceiling(ycoord)],
+                                height.map[ceiling(xcoord), floor(ycoord)],
+                                height.map[floor(xcoord),   floor(ycoord)]) < tanangheight)) next
+
+                      if (tanangheight < bilinear(height.map, xcoord, ycoord)) {
+                          shadow[i, j] <- shadow[i, j] - 1 / length(anglebreaks)
+                          break
+                      }
+                  }
+              }
+          }
+      }
+
+      shadow
+  }
+
+  bilinear <- function(data, x0, y0) {
+      i <- max(1, floor(x0))
+      j <- max(1, floor(y0))
+      XT <- (x0 - i)
+      YT <- (y0 - j)
+      result <- (1 - YT) * (1 - XT) * data[i, j]
+      nx <- nrow(data)
+      ny <- ncol(data)
+      if (i + 1 <= nx) {
+          result <- result + (1 - YT) * XT * data[i + 1, j]
+      }
+      if (j + 1 <= ny) {
+          result <- result + YT * (1 - XT) * data[i, j + 1]
+      }
+      if (i + 1 <= nx && j + 1 <= ny) {
+          result <- result + YT * XT * data[i + 1, j + 1]
+      }
+      result
+  }
+
+points <- rep(181L, 10) # 181 takes the longest to compute
+
+  s = 0
+  for (j in 1:n) {
+    for (i in points) {
+      s = s+sum(bench_rays(height.map = volcano, sun.angle = i))
+    }
+  }
+  # print(s)
+  s
+}

client/rsh/inst/benchmarks/simple/lapply-dots.R

@@ -0,0 +1,6 @@
+execute <- function(n=1000000) {
+  x <- 1:n
+  f <- function(x, y) x + 1.5 * y
+  a <- n / 2
+  lapply(x, f, y=a)
+}

client/rsh/src/bc2c/runtime.h

@@ -2351,4 +2351,14 @@ static INLINE void Rsh_LogBase(Value *val, Value base, SEXP call, SEXP rho) {
   }
 }
 
+static INLINE void Rsh_Math1(Value *v, SEXP call, int op, SEXO rho) {
+  if (VAL_IS_DBL(v)) {
+
+    double (*fun)(double) = getMath1Fun(GETOP(), call);
+
+    return;
+  }
+  // slow path
+}
+
 #endif // RUNTIME_H

server/src/test/java/org/prlprg/bc2c/BC2CCompilerTest.java

@@ -586,6 +586,12 @@ public void testLog(BC2CSnapshot snapshot) {
     snapshot.verify("log(5, 5)");
     snapshot.verify("log(c(1,10,100, NA), 5)");
   }
+
+  @Test
+  public void testMath1(BC2CSnapshot snapshot) {
+    snapshot.verify("sin(PI)");
+  }
+
   // API
 
   private TestResultCheck fastArith() {