void start_trace( short tnum, int revals ) {
int kk;
double** dum = 0;
int degree = 0;
revalso = revals;
tag = tnum;
/* Set buffer size to be the default in usrparms.h */
set_buf_size(BUFSIZE);
get_fstr(op_file_name,tag,FNAME);
get_fstr(int_file_name,tag,FNAME1);
get_fstr(val_file_name,tag,FNAME2);
get_fstr(vs_file_name,tag,FNAME3);
init_stat_space(tag);
/* Return old memory ... if used */
if(op_tape[tag]) free((char*)op_tape[tag]);
if(int_tape[tag]) free((char*)int_tape[tag]);
if(val_tape[tag]) free((char*)val_tape[tag]);
if(stats[tag]) free((char*)stats[tag]);
op_tape[tag] = (unsigned char *)malloc(BUFSIZE*sizeof(unsigned char));
int_tape[tag] = (locint *)malloc(BUFSIZE*sizeof(locint));
val_tape[tag] = (double *)malloc(BUFSIZE*sizeof(double));
stats[tag] = (int*)malloc(statSize*sizeof(int));
if ((op_tape[tag] == NULL) ||
(int_tape[tag] == NULL) ||
(val_tape[tag] == NULL) ||
(stats[tag] == NULL)) {
fprintf(DIAG_OUT,"ADOL-C error: cannot allocate tape buffers!\n");
exit (-1);
}
ind_ptr = 0;
dep_ptr = 0;
vs_ptr = 0;
/* Initialize Tapes */
set_buffers(op_file_name,op_tape[tag],
int_file_name,int_tape[tag],
val_file_name,val_tape[tag]);
/* Put operation denoting the start_of_the tape */
put_op(start_of_tape);
/* Leave space for the stats */
/* olvo 980914 unique size of stats block */
for (kk=0; kk<sizeof(int)/sizeof(locint)*statSpace; kk++)
put_locint(0);
if (revalso)
taylor_begin(tag,TBUFSIZE,dum,degree);
}
/*--------------------------------------------------------------------------*/
void get_val_stats( int tag, char **ret_val_file, int *ret_val_len,
int *ret_val_access,double **ret_val_tape) {
get_fstr(val_file_name,tag,FNAME2);
*ret_val_file = val_file_name;
*ret_val_len = stats[tag][9];
*ret_val_access = stats[tag][10];
*ret_val_tape = val_tape[tag];
}
/*--------------------------------------------------------------------------*/
void get_int_stats( int tag, char **ret_int_file, int *ret_int_len,
int *ret_int_access, locint **ret_int_tape ) {
get_fstr(int_file_name,tag,FNAME1);
*ret_int_file = int_file_name;
*ret_int_len = stats[tag][7];
*ret_int_access = stats[tag][8];
*ret_int_tape = int_tape[tag];
}
/*--------------------------------------------------------------------------*/
void get_op_stats( int tag, char **ret_op_file, int *ret_op_len,
int *ret_op_access, unsigned char **ret_op_tape ) {
get_fstr(op_file_name,tag,FNAME);
*ret_op_file = op_file_name;
*ret_op_len = stats[tag][5];
*ret_op_access = stats[tag][6];
*ret_op_tape = op_tape[tag];
}
/*--------------------------------------------------------------------------*/
static void read_tape_stats( short tag, int *stats ) {
char int_file[20];
FILE *int_file_in;
int version[adolcIDSize];
get_fstr(int_file,tag,FNAME1);
if ((int_file_in = fopen(int_file,"rb")) == 0) {
fprintf(DIAG_OUT,"ADOL-C error: Error reading integer tape number %d \n",
tag);
fprintf(DIAG_OUT,"Fopen returned error number %d \n",tag);
exit(-1);
}
if (fread((char *)stats,statSize*sizeof(int),1,int_file_in) != 1) {
fprintf(DIAG_OUT,"ADOL-C error: Error reading integer tape number %d \n",
tag);
fprintf(DIAG_OUT,"Fread returned error number %d \n",tag);
exit(-1);
}
/* olvo 980820 version check */
if (fread((char *)version,adolcIDSize*sizeof(int),1,int_file_in) != 1) {
fprintf(DIAG_OUT,"ADOL-C error: Error reading integer tape number %d \n",
tag);
fprintf(DIAG_OUT,"Fread returned error number %d \n",tag);
exit(-1);
}
if ( (version[0] < adolcID[0])
|| ((version[0] == adolcID[0]) && (version[1] < adolcID[1]))) {
fprintf(DIAG_OUT,"ADOL-C error: Used tape (%d) was written with ADOL-C"
" version older than %d.%d\n",
tag,ADOLC_VERSION, ADOLC_SUBVERSION);
fprintf(DIAG_OUT,"This is ADOL-C %d.%d.%d\n", ADOLC_VERSION,
ADOLC_SUBVERSION, ADOLC_PATCHLEVEL);
exit(-1);
}
if (version[3] != adolcID[3]) {
fprintf(DIAG_OUT,"ADOL-C error: Used tape (%d) was written with locints"
" of size %d, size %d required.\n",
tag, version[3], adolcID[3]);
exit(-1);
}
/* 981019 olvo: don't check sizeof(revreal)
if (version[4] != adolcID[4])
{ fprintf(DIAG_OUT,"ADOL-C error: Used tape (%d) was written with revreals"
" of size %d, size %d required.\n",
tag, version[4], adolcID[4]);
exit(-1);
} */
fclose(int_file_in);
}
void qopen(int *iunit, char *name, char *attribute, int name_l, int attr_l)
#endif
{
#ifdef F77STRING
char *name = f77name->str;
char *attribute = f77attribute->str;
int name_l = f77name->len;
int attr_l = f77attribute->len;
#endif
int unit = find_unit();
Unit *u = units + unit; /* JRK: Style, declarations should be up here. */
int noChars;
char oldfilename[327];
char matstr[16];
int mode, errSave;
char *modes[4] = {"rb", "rb+", "wb", "wb+"};
char *tailback;
struct stat buf;
if (unit >= 0) {
u->being_used = 1;
get_fstr(name, name_l, u->fname, sizeof u->fname);
u->write_only = 0;
u->read_only = 0;
u->pos = 0;
get_fstr(attribute, attr_l, matstr, sizeof matstr);
if (strncmp(matstr, "RO", 1) == 0){
mode = 0;
u->attribute = UNIT_ATBUT_RO;
u->read_only = 1;
}
if (strncmp(matstr, "NEW", 1) == 0){
get_fstr(name, name_l, oldfilename, sizeof u->fname);
/* DNM 10/20/03: check for existence of file before making backup,
and delete old backup first */
if (!getenv("IMOD_NO_IMAGE_BACKUP") && !stat(oldfilename, &buf)) {
oldfilename[strlen(oldfilename) + 1] = 0x00;
oldfilename[strlen(oldfilename)] = '~';
remove(oldfilename);
errno = 0;
if (rename(u->fname, oldfilename)) {
errSave = errno;
fprintf(stdout, "\nWARNING: qopen - Could not rename '%s' to '%s'"
"\n", u->fname, oldfilename);
if (errSave)
fprintf(stdout, "WARNING: from system - %s\n", strerror(errSave));
}
}
mode = 3;
u->attribute = UNIT_ATBUT_NEW;
}
if (strncmp(matstr, "OLD", 1) == 0){
mode = 1;
u->attribute = UNIT_ATBUT_OLD;
}
if (strncmp(matstr, "SCRATCH", 1) == 0){
mode = 3;
u->attribute = UNIT_ATBUT_SCRATCH;
}
errno = 0;
u->fp = fopen(u->fname, modes[mode]);
if (u->fp == NULL) {
fprintf(stdout, "\nERROR: qopen - Could not open '%s'\n" , u->fname);
errSave = errno;
if (errSave)
fprintf(stdout, "ERROR: from system - %s\n", strerror(errSave));
exit(3);
}
*iunit = unit + 1;
/* Get the tail of the filename for other error messages */
u->tailName = strrchr(u->fname, '/');
tailback = strrchr(u->fname, '\\');
if (tailback > u->tailName)
u->tailName = tailback;
if (!u->tailName)
u->tailName = &u->fname[0];
else
u->tailName++;
} else {
*iunit = -1;
}
}