从R调用C时出现堆损坏错误，找不到源问题

Question

UPDATE3:问题已经解决了，但是我把代码留在这里，作为将来的参考--我在下面发布了一个答案，上面是代码的最终状态，以防人们想看到最终的产品。

UPDATE2:重新考虑使用R_alloc而不是calloc进行自动清理。不幸的是，问题依然存在。

更新:如果我在UNPROTECT(1)之前添加这一行

Rprintf("%p %p %p", (void *)rans, (void *)fm, (void *)corrs);

然后，函数执行时没有损坏的堆错误。可能有一个后台垃圾收集调用会在执行完成之前破坏其中一个指针，从而导致对垃圾指针的写入？这里需要注意的是，如果我不打印出所有三个指针地址，错误就会返回。

此外，我还在M1 Mac上运行这个程序，并通过R CMD SHLIB与clang一起编译，以防苹果的硅片受到指责。

我正在尝试调试这个问题，我想我会求助于这个问题。我正在用C编写一个函数来优化我的R代码的某些部分，并且在多次运行该函数时，我得到了一个堆错误。函数trimCovar()是使用.Call("trimCovar", ...)接口从R调用的。

由于以下几个原因，我很难调试它：

我是在OSX上运行的，所以我不能使用errors)

• Error

• C函数依赖于来自R的输入，所以我不能在它自己的

• 堆上调试C代码，只有在一个R函数内多次调用该函数时才会发生损坏(只是直接运行.Call --很多次没有inconsistent

点)

我从两组向量开始，将它们压缩成一个频率矩阵，其中每一列都是向量集中的一个位置，每一行都是出现的一个特定字符。在传入之前，我将它们连接到一个矩阵中，因为它使预处理更容易。频率矩阵的一个玩具例子是：

INPUT:             
  v1_1 = 101
  v1_2 = 011

  v2_1 = 111
  v2_2 = 110

Frequency Matrix:

position: | 1_1 | 1_2 | 1_3 | 2_1 | 2_2 | 2_3 |

0:          0.5   0.5   0.0   0.0   0.0   0.5
1:          0.5   0.5   1.0   1.0   1.0   0.5

我们的目标是在向量集中找到NV最高相关位置，这是通过计算位置的两两KL散度来实现的。这些被存储在一个按升序排序的链接列表中，在最后，我采取与第一个NV条目相对应的位置。我所拥有的R代码可以离开其他所有的东西，所以我确实需要一个位置向量在末尾(允许重复)。

该函数包含5个参数：

• fMAT:一个频率矩阵(RObject，因此被读取为平面向量)
• fSP :矩阵中对应于来自第一个向量集
• sSP的位置的列:与fSP相同，但对于第二个向量集
• NV:返回

H 131NR的值数:fMATH 232f 233/code>中的列数>

返回的错误是：

R(95564,0x104858580) malloc: Heap corruption detected, free list is damaged at 0x600000f10040
*** Incorrect guard value: 4626885667169763328
R(95564,0x104858580) malloc: *** set a breakpoint in malloc_error_break to debug

这只有在我运行一个调用这个10+时间的R函数时才会发生，所以我假设我只是缺少一两个小的挂起的指针，从而破坏了一个内存引用。我试着在每次调用之后立即使用gc()调用R来运行这个程序，但是它并没有解决问题。我不太确定现在还能做什么，我试过使用lldb，但我不太确定如何使用该程序。通过运行大量的print语句，我确定它通常会在主循环中崩溃(在下面的代码中可以识别)，但是在崩溃的时候它是不一致的。我还试着避免错误的输入--我可以在没有问题的情况下单独运行它们，所以它必须是相对较小的，只在多次运行时出现。

如果有帮助的话，很乐意提供更多的细节。代码列在底部。

这里唯一分配的是链接列表节点，我以为在返回之前我已经将它们都分配给了free()。我还双倍地检查了输入值，因此我99.99%确信我从未在firstSeqPos、secondSeqPos、ans或fm上引用超出界限的值。我还三次检查了围绕着它的R代码，并且可以自信地说它不是这个错误的来源。

我已经很长时间没有用C语言编码了，所以我觉得我遗漏了一些显而易见的东西。如果我真的必须这样做的话，我可以尝试获得一个Linux机器来运行val研，但是如果有其他的选择，我会更喜欢它。提前感谢！

代码：

#include <R.h>
#include <Rdefines.h>
#include <Rinternals.h>
#include <math.h>
#include <stdlib.h>
#include <stdbool.h>

typedef struct node {
  double data;
  int i1;
  int i2;
  struct node *next;
} node;

// Linked list
// data is the correlation value,
// i1 the position from first vector set,
// i2 the position from second vector set
node *makeNewNode(double data, int i1, int i2){
  node *newNode; 
  newNode = (node *)R_alloc(1, sizeof(node));
  newNode->data = data;
  newNode->i1 = i1;
  newNode->i2 = i2;
  newNode->next = NULL;
  return(newNode);
}

//insert link in sorted order (ascending)
void insertSorted(node **head, node *toInsert, int maxSize) {
  int ctr = 0;
  if ((*head) == NULL || (*head)->data >= toInsert->data){
    toInsert->next = *head;
    *head = toInsert;
  } else {
    node *temp = *head;
    while (temp->next != NULL && temp->next->data < toInsert->data){
      temp = temp->next;
      if (ctr == maxSize){
        // Performance optimization, if we aren't inserting in the first NR
        // positions then we can just skip since we only care about the NR 
        // lowest scores overall
        return;
      }
      ctr += 1;
    }
    toInsert->next = temp->next;
    temp->next = toInsert;
  }
}

// MAIN FUNCTION CALLED FROM R
// (This is the one that crashes)
SEXP trimCovar(SEXP fMAT, SEXP fSP, SEXP sSP, SEXP NV, SEXP NR){
  // Converting input SEXPs into C-compatible values
  int nv = asInteger(NV);
  int nr = asInteger(NR);
  int sp1l = length(fSP);
  int sp2l = length(sSP);

  int *firstSeqPos = INTEGER(coerceVector(fSP, INTSXP));
  int *secondSeqPos = INTEGER(coerceVector(sSP, INTSXP));
  double *fm = REAL(fMAT);
  int colv1, colv2;

  // Using a linked list for efficient insert
  node *corrs = NULL;
  int cv1, cv2;
  double p1, p2, score=0;

  // USUALLY FAILS IN THIS LOOP
  for ( int i=0; i<sp1l; i++ ){
    cv1 = firstSeqPos[i];
    colv1 = (cv1 - 1) * nr;
    for ( int j=0; j<sp2l; j++ ){
      cv2 = secondSeqPos[j];
      colv2 = (cv2 - 1) * nr;

      // KL Divergence
      score = 0;
      for ( int k=0; k<nr; k++){
        p1 = fm[colv1 + k];
        p2 = fm[colv2 + k];
        if (p1 != 0 && p2 != 0){
          score += p1 * log(p1 / p2);
        }
      }
      // Add result into LL
      node *newNode = makeNewNode(score, cv1, cv2);
      insertSorted(&corrs, newNode, nv);
    }
    R_CheckUserInterrupt();
  }
  SEXP ans;
  PROTECT(ans = allocVector(INTSXP, 2*nv));
  int *rans = INTEGER(ans); 
  int ctr=0;
  int pos1, pos2;
  node *ptr = corrs;

  for ( int i=0; i<nv; i++){
    rans[2*i] = ptr->i1;
    rans[2*i+1] = ptr->i2;
    ptr = ptr->next;
  }

  UNPROTECT(1);
  return(ans);
}

Answer 1

int *firstSeqPos = INTEGER(coerceVector(fSP, INTSXP));
int *secondSeqPos = INTEGER(coerceVector(sSP, INTSXP));

这真是不太好。对coerceVector()的2次调用返回的SEXP需要受到保护。然而，通常认为在进入.Call入口点之前在R级别进行强制是更好的做法。请注意，如果fSP和sSP是整数矩阵，则没有必要强迫它们使用整数，因为它们在C级别上已经被视为整数向量。这也避免了可能昂贵的副本(R中的as.integer()和C中的coerceVector()都触发了矩阵数据的完整副本)。

Answer 2

上面已经回答了这个问题，但是我收到了一些人的消息，询问最后的代码，所以我将把它作为一个答案来保存原来的问题。这里有几个优化(感谢@hpages提供有关这些方面的帮助和故障排除)：

• 原始代码失败，因为coerceVector()的输出没有受到PROTECT()的保护。我重构了R代码，以便在调用这个C函数之前检查整数输入，以避免这个函数调用，并提高内存效率(更多的details).
• Original代码使用R_alloc()，请参阅已接受的答案，这使R负责在函数调用结束时清理内存。但是，这会在函数运行时引入大量内存开销，因为分配给未插入链接列表的节点的内存直到函数call.
• Allocation的末尾才会清除，而calloc()并不像在函数结束时切换和调用free()那样简单，因为我们必须保护用户中断程序执行的情况。如果在函数结束之前抛出中断信号，我们将永远不会释放内存。

最后C代码：

#include <R.h>
#include <Rdefines.h>
#include <Rinternals.h>
#include <math.h>
#include <stdlib.h>
#include <stdbool.h>

typedef struct node {
  double data;
  int i1;
  int i2;
  struct node *next;
} node;

// Defining the head as a static so that we can access it globally
// Important for ensuring clean up in case of interrupt
static node *corrs = NULL;

// Function to clean up memory allocations in case of interrupt
void cleanupFxn(){
  node *ptr = corrs;
  // Free allocated memory in linked list
  while (corrs != NULL){
    ptr = corrs;
    corrs = corrs->next;
    free(ptr);
  }
}

node *makeNewNode(double data, int i1, int i2){
  node *newNode; 
  // very important to use calloc here so we have control of when we free it
  // R_alloc() memory won't be freed until after function finishes execution
  newNode = (node *)calloc(1, sizeof(node));
  newNode->data = data;
  newNode->i1 = i1;
  newNode->i2 = i2;
  newNode->next = NULL;
  return(newNode);
}

// insert link in sorted order
// returns a bool corresponding to if we inserted
bool insertSorted(node **head, node *toInsert, int maxSize) {
  int ctr = 0;
  if ((*head) == NULL || (*head)->data >= toInsert->data){
    toInsert->next = *head;
    *head = toInsert;
    return(true);
  } else {
    node *temp = *head;
    while (temp->next != NULL && temp->next->data < toInsert->data){
      temp = temp->next;
      if (ctr == maxSize){
        // Performance optimization, if we aren't inserting in the first NR
        // positions then we can just skip since we only care about the NR 
        // lowest scores overall. Saves a huge amount of time and memory.
        return(false);
      }
      ctr += 1;
    }
    toInsert->next = temp->next;
    temp->next = toInsert;
    return(true);
  }
}

SEXP trimCovar(SEXP fMAT, SEXP fSP, SEXP sSP, SEXP NV, SEXP NR){
  // Converting inputs into C-compatible forms
  int nv = asInteger(NV);
  int nr = asInteger(NR);
  int sp1l = length(fSP);
  int sp2l = length(sSP);

  // Note here we're not using coerceVector() anymore
  // typechecking done on R side
  int *firstSeqPos = INTEGER(fSP);
  int *secondSeqPos = INTEGER(sSP);
  double *fm = REAL(fMAT);
  int colv1, colv2;
  
  // Using a linked list for efficient insert
  corrs = NULL;
  int cv1, cv2;
  double p1, p2, score=0;
  bool success;
  for ( int i=0; i<sp1l; i++ ){
    cv1 = firstSeqPos[i];
    colv1 = (cv1 - 1) * nr;
    for ( int j=0; j<sp2l; j++ ){
      cv2 = secondSeqPos[j];
      colv2 = (cv2 - 1) * nr;

      score = 0;
      for ( int k=0; k<nr; k++){
        p1 = fm[colv1 + k];
        p2 = fm[colv2 + k];
        if (p1 != 0 && p2 != 0){
          score += p1 * log(p1 / p2);
        }
      }
      node *newNode = makeNewNode(score, cv1, cv2);
      success = insertSorted(&corrs, newNode, nv);
      // If we don't insert, free the associated memory
      // I'm checking for NULL here just out of an abundance of caution
      if (!success && newNode != NULL){
        free(newNode);
        newNode = NULL;
      }
    }
    R_CheckUserInterrupt();
  }


  SEXP ans;
  PROTECT(ans = allocVector(INTSXP, 2*nv));
  int *rans = INTEGER(ans); 
  node *ptr=corrs;

  for ( int i=0; i<nv; i++){
    rans[2*i] = ptr->i1;
    rans[2*i+1] = ptr->i2;
    ptr = ptr->next;
  }

  // Free allocated memory in linked list
  cleanupFxn();

  UNPROTECT(1);
  return(ans);
}

假设C文件名为trimCovar.c，我们将使用R CMD SHLIB trimCovar.c进行编译。

R运行此函数的代码：

dyn.load("trimCovar.so")

# Wrapped into a function with on.exit(...) to ensure cleanup
# in the event the user or system interrupts execution early
CorrComp_C <- function(fm, fsp, ssp, nv, nr){
  # type checking to ensure input to C is integer vector
  # (could probably do more type checking here, mainly for illustration)
  stopifnot(is(fsp, 'integer'))
  stopifnot(is(ssp, 'integer'))
  on.exit(.C("cleanupFxn"))
  a <- .Call('trimCovar', fm, fsp, ssp, nv, nr)
  return(a)
}