src/readKeyMap.c

   1 #define NEED_CONNECTION_PSTREAMS
   2
   3 #include <R.h>
   4 #include <Rinternals.h>
   5
   6 SEXP read_key_map(SEXP filename, SEXP map, SEXP filesize, SEXP pos)
   7 {
   8         SEXP key, datalen;
   9         FILE *fp;
  10         int status, len;
  11         struct R_inpstream_st in;
  12
  13         if(!isEnvironment(map))
  14                 error("'map' should be an environment");
  15         if(!isString(filename))
  16                 error("'filename' should be character");
  17
  18         PROTECT(filesize = coerceVector(filesize, INTSXP));
  19         PROTECT(pos = coerceVector(pos, INTSXP));
  20
  21         fp = fopen(CHAR(STRING_ELT(filename, 0)), "rb");
  22
  23         if(INTEGER(pos)[0] > 0) {
  24                 status = fseek(fp, INTEGER(pos)[0], SEEK_SET);
  25
  26                 if(status < 0)
  27                         error("problem with initial file pointer seek");
  28         }
  29
  30         /* Initialize the incoming R file stream */
  31         R_InitFileInPStream(&in, fp, R_pstream_any_format, NULL, NULL);
  32
  33         while(INTEGER(pos)[0] < INTEGER(filesize)[0]) {
  34                 PROTECT(key = R_Unserialize(&in));
  35                 PROTECT(datalen = R_Unserialize(&in));
  36                 len = INTEGER(datalen)[0];
  37
  38                 /* calculate the position of file pointer */
  39                 INTEGER(pos)[0] = ftell(fp);
  40
  41                 if(len <= 0) {
  42                         /* key has been deleted; set pos to NULL */
  43                         defineVar(install(CHAR(STRING_ELT(key, 0))),
  44                                   R_NilValue, map);
  45                         UNPROTECT(2);
  46                         continue;
  47                 }
  48                 /* create a new entry in the key map */
  49                 defineVar(install(CHAR(STRING_ELT(key, 0))), duplicate(pos), map);
  50
  51                 /* advance to the next key */
  52                 status = fseek(fp, len, SEEK_CUR);
  53
  54                 if(status < 0) {
  55                         fclose(fp);
  56                         error("problem with seek");
  57                 }
  58                 INTEGER(pos)[0] = INTEGER(pos)[0] + len;
  59
  60                 UNPROTECT(2);
  61         }
  62         UNPROTECT(2);
  63         fclose(fp);
  64         return map;
  65 }