RCUDA: R Bindings for the CUDA Library for GPU Computing

# To fix
#  write enums to .R file
#  generate C++ converters for enums to SEXP.
#  It is only Renum_convert_CUarray_format
#
# We have the (programmatically generated) code but it is called R_bitwise_enum_convert_CUarray_format
#
# We seem to have code to generate these from 2014 - tu1.R - that uses RGCCTranslationUnit
# Generate converters for those that are
#  in structures
#  explicitly returned by a C routine
#  returned via a pointer as a parameter.
#

#
#  For bitwise enums, we have - in RConverters.c - the generic R_bitwise_enum_convert routine
# and we pass it the array of  values and the array of names, length and class name
#
#  Should we call the converters - and the enum types - with a prefix enum, as we do,
#  and if we do, we need to change the name of the conversion routine for the enum to append the enum to the end.
#  This occurs in the structCopy.c
#
#

source("getTU.R")

fn = sapply(r, function(x) getFileName(x@def))

 # have to handle . in getwd().
 # find the routines that are in /usr/local/cuda/include and not those in /usr/include or .
r.cu = r[grepl(sprintf("(%s)", paste(gsub("\\.", "\\\\./", incs), collapse = "|")), fn)]

names(r.cu)[!grepl("^cu", names(r.cu))]
# With CUDA SDK 7.5, there are none
#   For CUDA 5.*  All of these are make_...  54 of them.  Now with curand.h we get additional entries.

# Find all routines that return either cudaError_t
status = sapply(r.cu, function(x) getName(x@returnType) %in% c("CUresult", "cudaError_t", "enum cudaError"))
table(status)

# For cuda and not cublas, there are only 2 that don't return CUresult/cudaError_t
#  cudaGetErrorString and cudaCreateChannelDesc().
# For CUDA SDK 7.5, we also get cudaGetErrorName(), along with cudaGetErrorString and cudaCreateChannelDesc()
names(r.cu)[!status]



ds = getDataStructures(tu)
fn = sapply(ds, function(x) getFileName(x@def))
ds.cu = ds[grepl(sprintf("(%s)", paste(gsub("\\.", "\\\\./", incs), collapse = "|")), fn)]

# CUDA SDK 7.5:   343 data structures.

###############


enums =  getEnums(tu)
# ?? Do we want to limit these to those /usr/local/cuda/include.  If so, we need to get the file name
# of the definition and the cursor is not in the enum. We can change RCIndex to add it.

ecode = lapply(enums, makeEnumConverter)
#writeCode(code, "../R/autoEnumConverters.R", lang = "R")
writeCode(ecode, "../src/autoEnumConverters.c", lang = "C")

cat(sprintf("/* autogenerated %s */", Sys.Date()), paste(sapply(ecode, slot, "declaration"), ";", collapse = "\n"), sep = "\n", file = "../src/autoEnumDecls.h")

cat(sprintf("# Autogenerated %s", Sys.Date()), unlist(lapply(enums, makeEnumClass)), file = "../R/autoEnums.R", sep = "\n\n")

exp[["Enums"]] = sprintf("exportClasses(%s)", paste(RCodeGen:::enumClassName(name = names(enums)), collapse = ",\n"))

###################################################################################################
#
# Context routines
ctx = grep("^cuCtx", names(r.cu), value = TRUE)
# deprecated ones are cuCtxAttach and cuCtxDetach.
ctx = setdiff(ctx, c("cuCtxAttach", "cuCtxDetach"))
# ?? What about cuDeviceCanAccessPeer - not a context thing, in cuDevice

exp[["Context"]] = generateCode(r.cu[ctx], "Context")
# To put the code in /tmp
#generateCode(r.cu[ctx], c("/tmp/Context.c", "/tmp/Context.R"))

################

dev = grep("^cu(da)?Device", names(r.cu), value = TRUE)
# Ignore GetName for now.
dev = setdiff(dev, c("cuDeviceComputeCapability", "cuDeviceGetProperties")) # "cuDeviceGetName", "cuDeviceGetByPCIBusId", "cuDeviceGetPCIBusId"))

exp[["Device"]] = generateCode(r.cu[dev], "Device")
#generateCode(r.cu[dev], c("/tmp/Device.c", "/tmp/Device.R"))

######

mod = grep("^cu(da)?Module", names(r.cu), value = TRUE)
mod = setdiff(mod, c("cuModuleLoadDataEx"))
#cuda.createNativeProxy(r.cu$cuModuleLoad)

exp[["Module"]] = generateCode(r.cu[mod], "Module")
#generateCode(r.cu[mod], c("/tmp/Module.c", "/tmp/Module.R"))


#######
func = grep("^cu(da)?Func", names(r.cu), value = TRUE)
exp[["Function"]] = generateCode(r.cu[func], "Function")
#generateCode(r.cu[func], c("/tmp/Function.c", "/tmp/Function.R"))

########

ev = grep("^cu(da)?Event", names(r.cu), value = TRUE)
exp[["Event"]] = generateCode(r.cu[ev], "Event")
#generateCode(r.cu[ev], c("/tmp/Event.c", "/tmp/Event.R"))

#########

ev = grep("^cu(da)?Stream", names(r.cu), value = TRUE)
exp[["Stream"]] = generateCode(r.cu[ev], "Stream")
#generateCode(r.cu[ev], c("/tmp/Stream.c", "/tmp/Stream.R"))



############

mem = grep("^cuMem", names(r.cu), value = TRUE)
mem = grep("^cu(da)?Mem", names(r.cu), value = TRUE)
   # cuMemGetInfo works fine when autogenerated, but we have a manual version that
   # simplifies the result to a numeric vector.  Could identify this programmatically
   # or try to simplify in the R code.
mem = setdiff(mem, c("cuMemGetInfo", "cudaMemGetInfo", "cuMemcpy"))  # cudaMemcpy was here. the MemGetInfo on we wrote puts names on the vector of results
#lapply(r.cu[mem], cuda.createNativeProxy)
exp[["Memory"]] = generateCode(r.cu[mem], "Memory")
#generateCode(r.cu[mem], c("/tmp/Memory.c", "/tmp/Memory.R"))

# Other memory related routines
grep("^cu.+Mem", names(r.cu), value = TRUE)

# [Done] event, stream, 
# memory - richer types e.g. array,...
# texture, surface



###############
ds.cuTypes = ds.cu[ grep("^(cu|CU)", names(ds.cu), value = TRUE) ]
structs = sapply(ds.cuTypes, function(x) is(x, "StructDefinition") && length(x@fields) > 0 && x@name["name"] != "") 
ds.cuTypes = ds.cuTypes[  structs  ]


#structs = sapply(ds.cu, function(x)  getName(x$def) != "")
#ds.cuTypes = ds.cu[structs]
#XXX Avoid duplicate names, e.g. for typedef and struct.
# All structs.

sizeofCode = CRoutineDefinition("R_getSizeofStructs", 
               c('extern "C"',
                 "SEXP R_getSizeofStructs()", "{",
                 "SEXP r_ans, names;",
                 sprintf("unsigned int i = 0, n = %d;", length(ds.cuTypes)),
                 "PROTECT(r_ans = NEW_INTEGER(n));",
                 "PROTECT(names = NEW_CHARACTER(n));",
                 "",
                 sprintf('INTEGER(r_ans)[i] = sizeof(%s);\n    SET_STRING_ELT(names, i++, mkChar("%s"));',
                          sapply(ds.cuTypes, function(x) x@name["name"]), names(ds.cuTypes)),                             # x@name["name"] was  getName(getType(x@def))
                 "",
                 "SET_NAMES(r_ans, names);",
                 "UNPROTECT(2);",
                 "return(r_ans);", "}"))#, declaration = "SEXP R_getSizeofStructs()")

writeCode(as(sizeofCode, "character"),  "../src/autoSizeofStructs.cpp",  
            c('"RCUDA.h"', sprintf("<%s>", basename(unique(sapply(ds.cuTypes, function(x) getFileName(x@def)))))))


typeNames = c("int", "long", "short", "char", "float", "double", names(ds.cuTypes))

showSizeofs = cat(c(sprintf("// autogenerated %s. See TU/clang.R", as.character(Sys.time())),
   "void",
  "showSizeofs()",
  "{",
  'fprintf(stdout, "CUDAStructSizes = c(\\n");',
  sprintf('fprintf(stdout, " %s = %%dL%s\\n", (int) sizeof(%s));', typeNames, c(rep(",", length(typeNames) - 1L), ""), typeNames),
  'fprintf(stdout, ")\\n");',
  "}"), sep = "\n", file = "../showSizeofs.cu")





# Or a lookup routine which just computes one per call.
code = c("SEXP", "R_getStructSizeof(SEXP r_id)", "{", "const char *target = CHAR(STRING_ELT(r_id));",
paste(sprintf('if(strcmp(target, "%s") == 0) return(ScalarInteger(sizeof(%s)));', names(ds.cu[structs]), names(ds.cu[structs])), collapse = "\nelse "),
  "else return(ScalarReal(NA_REAL));",
  "}")


########################################

# Figure out what other routines to generate code for.
# Look in the src/*.c files for code that calls any of the CUDA routines.

manual = c("cudaGetExportTable", "cuGetExportTable", "cudaConfigureCall", "cudaSetupArgument")

incs = c(".", "/usr/local/cuda/include")
rincs = c(incs, sprintf("%s/include", R.home()), sprintf("%s/../src/include", R.home()))
cfiles = list.files("../src", pattern = "*.c$", full.names = TRUE)

# Don't look in autoOther.c
cfiles = cfiles[ !grepl("autoOther.c", cfiles) ]
kalls = unlist(lapply(cfiles, findCalls, includes = rincs))

# We are not goint to generate
cuCalls = grep("^cu", unique(unlist(kalls)), value = TRUE)
deprecated = scan("../deprecated", what = "", quiet = TRUE)
missingOnes = setdiff(names(r.cu), c(cuCalls, deprecated, manual))
#missing = setdiff(missing, deprecated)

# Don't seem to use this.
#w = sapply(r.cu[missingOnes], function(x)  { toks = getCursorTokens(x@def) ; any(grepl("__device", toks)) && !any(grepl("__host", toks))})

want = grep("(^make|Mip|Ipc|Texture|TexRef|Tex|Surface|Surf|curand)", missingOnes, invert = TRUE, value = TRUE)

generateCode(r.cu[want], "Other")
#generateCode(r.cu[want], c("/tmp/Other.c", "/tmp/Other.R"))

##############

 # The structures or the typedefs?
structCode = lapply(list(ds.cu$CUDA_ARRAY_DESCRIPTOR, ds.cu$CUDA_ARRAY3D_DESCRIPTOR), makeCCopyStructCode)
writeCode(structCode, "../src/structCopy.c", lang = "C")
#writeCode(structCode, "/tmp/structCopy.c", lang = "C")


############

# Handle the typedefs.
typedefs = getTypedefs(tu)
i = grep("/cuda/", sapply(typedefs, getFileName))

tydefs = typedefs[i]
enumTyDefs = tydefs[ sapply(tydefs, function(x) getCanonicalType(getType(x))$kind == CXType_Enum) ]

a = sapply(enumTyDefs, getName)
b = gsub("^enum ", "", enumClassName(name = sapply(enumTyDefs, function(x) getName(getCanonicalType(getType(x))))))
i = a != b

coerces = sapply(enumTyDefs, function(x) makeEnumCoerce(name = getName(x), valuesSym = sprintf("%sValues", enumClassName( name = getName ( getCanonicalType(getType(x)))))))
code = c( sprintf("setClass('%s', contains = '%s')", a[i], b[i]),
          sprintf("%sValues = %sValues", a[i], b[i]),
          coerces
        )

cat(sprintf("# Autogenerated %s", Sys.Date()), "", code, sep = "\n", file = "../R/autoTypedefs.R")

exp[["Typedefs"]] = sprintf("exportClasses(%s)", paste(a[a != b], collapse = ",\n"))

#mapply(makeEnumClass
#makeEnumCoerce

############

# Add the exports to the NAMESPACE
ns = readLines("../NAMESPACE")
i = grep("#* Autogenerated", ns, fixed = TRUE)
ns = c(ns[1:i], "\n\n", unlist(exp))

cat(ns, sep = "\n", file = "../NAMESPACE")