/* files.c, begun 12/5/91 using fragments from earlier fzread modules */ /* for little endian machines, define LITTLEENDIAN or this will not compile correctly ! */ #include "defs.h" #include "tiff.h" #include #include #include #include #include #include "ana_structures.h" #include #include #include #include #include #include "fitsio.h" #if __APPLE__ #else #include #endif //#include #include #include #include #include #include #include #include #if __sgi #include #endif #if defined(LINUX) #include #endif #if defined(SOLARIS) #include #include #include #endif //#include #if NeXT #include //#else //#if __FreeBSD__ //#include #else #include //#endif #endif /* for SGI only (?) */ #if __sgi #include #endif #if __APPLE__ /* the G5's have 64 bit file stuff by default */ #define off64_t off_t #define stat64 stat #define lstat64 lstat #define lseek64 lseek #endif /* libc needed on some systems for atoh, also need library in link */ extern struct sym_desc sym[]; extern int ana_type_size[]; extern int anadecrunch(), anadecrunch8(); extern int edb2_base; extern FILE *anain; extern int crunch_bits; extern float crunch_bpp; extern char prompt[]; union types_ptr { byte *b; short *w; int *l; float *f; double *d;}; regex_t re; extern int scrat[]; /* scratch storage, also used in anatest.c */ struct fzhead { /* first block for fz files */ int synch_pattern; byte subf; byte source; /* byte nhb,datyp,ndim,free1; */ /* use former free1 for file_class */ byte nhb,datyp,ndim,file_class; byte cbytes[4]; /* can't do as int because of %4 rule*/ byte free[178]; int dim[16]; /* has to be int for backward compatibility */ char txt[256];}; /* the following structure is the same as sym_desc except that the array pointer is replaced with an int (assumed to be I*4) to use for storing descriptor in files that can be read by machines with different pointer sizes */ struct sym_desc_file { byte class,type; short xx; union { union { byte b; short w; int l; float f; double d;} scalar; /* struct { int *ptr; int bstore; } array; */ struct { int offset; int bstore; } array; struct { unsigned short args[4]; } evb; struct { unsigned short args[4]; } edb; } spec;}; /* some tables for lun type files */ #define MAXFILES 5 FILE *ana_file[MAXFILES]; int ana_file_open[MAXFILES]; /* our own flag for each file */ int ana_rec_size[MAXFILES]; /*for associated variable files */ /* items used by ASCII read routines */ #define MAXLINE 1024 int maxline = MAXLINE; static char line[MAXLINE], *ulib_path; static int runlengthflag = 0; static int myleftover = 0; char *str, *str2; int index_cnt, line_cnt, left_cnt, eof_noise_flag = 1; int crunch_slice = 5, read_file_class; int spawn_status = 0, match_flag = 0; /* some frequently used variables, volatile */ int lun; size_t dim[8]; char *name; FILE *fin; static int nfiles, max, recursive_flag = 0, get_type_flag; static char **p; static int fits_head_malloc_flag = 0; static char *fitshead, *preamble; int socketTimeout = 10, socketTimeoutUsec = 0; /* for TIFF */ int photometric; /* accessed by symbols */ static char *tiff_colormap = {"$TIFF_COLORMAP"}; static const long tiff_type_size[13] = {0,1,1,2,4,8,1,1,2,4,8,4,8}; static const long tiff_typemask[13] = { 0, /* TIFF_NOTYPE */ 0x000000ff, /* TIFF_BYTE */ 0xffffffff, /* TIFF_ASCII */ 0x0000ffff, /* TIFF_SHORT */ 0xffffffff, /* TIFF_LONG */ 0xffffffff, /* TIFF_RATIONAL */ 0x000000ff, /* TIFF_SBYTE */ 0x000000ff, /* TIFF_UNDEFINED */ 0x0000ffff, /* TIFF_SSHORT */ 0xffffffff, /* TIFF_SLONG */ 0xffffffff, /* TIFF_SRATIONAL */ 0xffffffff, /* TIFF_FLOAT */ 0xffffffff, /* TIFF_DOUBLE */ }; static const int litTypeshift[13] = { 0, /* TIFF_NOTYPE */ 0, /* TIFF_BYTE */ 0, /* TIFF_ASCII */ 0, /* TIFF_SHORT */ 0, /* TIFF_LONG */ 0, /* TIFF_RATIONAL */ 0, /* TIFF_SBYTE */ 0, /* TIFF_UNDEFINED */ 0, /* TIFF_SSHORT */ 0, /* TIFF_SLONG */ 0, /* TIFF_SRATIONAL */ 0, /* TIFF_FLOAT */ 0, /* TIFF_DOUBLE */ }; static const int bigTypeshift[13] = { 0, /* TIFF_NOTYPE */ 24, /* TIFF_BYTE */ 0, /* TIFF_ASCII */ 16, /* TIFF_SHORT */ 0, /* TIFF_LONG */ 0, /* TIFF_RATIONAL */ 16, /* TIFF_SBYTE */ 16, /* TIFF_UNDEFINED */ 24, /* TIFF_SSHORT */ 0, /* TIFF_SLONG */ 0, /* TIFF_SRATIONAL */ 0, /* TIFF_FLOAT */ 0, /* TIFF_DOUBLE */ }; /*------------------------------------------------------------------------- */ #if defined(__sgi) int ana_getdtablehi(narg, ps) /* get the # of open files (plus 1) */ int narg, ps[]; { int result_sym; result_sym = scalar_scratch(2); sym[result_sym].spec.scalar.l = getdtablehi(); return result_sym; } #endif /*------------------------------------------------------------------------- */ // int ana_listenport(narg, ps) /* create a socket and listen */ // int narg, ps[]; // { // } /*------------------------------------------------------------------------- */ int ana_connectport(narg, ps) /* connect to a port on a server */ /* call is sock = connectport(port#, iphex) */ int narg, ps[]; { int port, stat; int ipadd, sock, i, bool = 1; struct sockaddr_in scin; printf("in ana_connectport\n"); if (int_arg_stat(ps[0], &port) != 1) return -1; if (int_arg_stat(ps[1], &ipadd) != 1) return -1; printf("passed port, ipadd = %d, %#x\n", port, ipadd); /* Create a socket */ if ((sock = socket (PF_INET, SOCK_STREAM, 0)) < 0) { perror("Can't open socket"); return -1; } /* Initialize the socket address to the server's address. */ bzero((char *) &scin, sizeof(scin)); scin.sin_family = AF_INET; scin.sin_addr.s_addr = (u_long) ( unsigned int) ipadd; scin.sin_port = htons((short) port); /* Connect to the server. */ if (connect(sock, (struct sockaddr *) &scin, sizeof(scin)) < 0) { close(sock); perror("Connect to server"); return 4; } printf("Connection established, socket # %d\n", sock); /* make this a non-blocking socket */ /* but it doesn't work */ //stat = fcntl(sock, O_NONBLOCK); stat = fcntl(sock, O_NDELAY); i = scalar_scratch(2); sym[i].spec.scalar.l = sock; return i; } /*------------------------------------------------------------------------- */ int ana_read_sock(narg, ps) /* read n bytes from a socket */ /* return a string from a socket, this read requires a count, this is a primitive, initial form 10/25/2003 - add a timeout of 10s using select string = read_sock(sock, n) */ int narg, ps[]; { int sock, ns, result_sym, cnt, iq, nfound; size_t rcnt; char *q, *q2; struct timeval timeout; fd_set ready; //printf("in ana_read_sock\n"); if (int_arg_stat(ps[0], &sock) != 1) return -1; if (int_arg_stat(ps[1], &ns) != 1) return -1; //printf("sock, ns = %d, %#x\n", sock, ns); result_sym = string_scratch(ns); q = (char *) sym[result_sym].spec.array.ptr; timeout.tv_sec = socketTimeout; /* Wait 10 seconds for a connect request */ timeout.tv_usec = socketTimeoutUsec; FD_ZERO(&ready); FD_SET(sock, &ready); nfound = select(sock+1, &ready, 0, 0, &timeout); //printf("nfound = %d\n", nfound); if (nfound == 0) { /* this is a timeout */ printf("timeout in ana_read_sock\n"); cnt = 0; } else { cnt = read(sock, q, ns); } //rcnt = recv(sock, q, (size_t) ns, NULL); //cnt = (int) rcnt; if (cnt != ns ) { //printf("request was %d but bytes read = %d\n", ns, cnt); /* redefine the string length (often a NULL) */ if (cnt >= 0) { iq = string_scratch(cnt); q2 = (char *) sym[iq].spec.array.ptr; if (cnt >= 1) bcopy(q, q2, cnt); if ( delete_symbol(result_sym) != 1 ) return execute_error(17); result_sym = iq; } } return result_sym; } /*------------------------------------------------------------------------- */ int ana_sock_nbyte(narg, ps) /* returns byte count on a socket */ int narg, ps[]; { int sock, ns, result_sym, cnt, iq, stat; if (int_arg_stat(ps[0], &sock) != 1) return -1; result_sym = scalar_scratch(2); //stat = ioctl(sock, I_NREAD, &cnt); //printf("stat %d, cnt %d\n", stat, cnt); if (stat <= 0) cnt = 0; sym[result_sym].spec.scalar.l = cnt; return result_sym; } /*------------------------------------------------------------------------- */ int ana_write_sock(narg, ps) /* write n bytes to a socket */ /* send a string to a socket, this write requires a count, this is a primitive, initial form write_sock(string, socket, ns) */ int narg, ps[]; { int sock, ns, result_sym, cnt; char *p; //("in ana_write_sock\n"); if ( sym[ ps[0] ].class != 2 ) return execute_error(70); p = (char *) sym[ps[0] ].spec.array.ptr; if (int_arg_stat(ps[1], &sock) != 1) return -1; if (int_arg_stat(ps[2], &ns) != 1) return -1; //printf("sock, ns = %d, %#x\n", sock, ns); result_sym = string_scratch(ns); cnt = write(sock, p, ns); //printf("bytes written = %d\n", cnt); return 1; } /*------------------------------------------------------------------------- */ int ana_spawn(narg, ps) /* execute a shell command */ int narg, ps[]; { char *p; /* uses the system call to execute a shell command, but may not be the shell you want! depends on local setup */ if ( sym[ ps[0] ].class != 2 ) return execute_error(70); p = (char *) sym[ps[0] ].spec.array.ptr; spawn_status = system(p); /* if (spawn_status == 0) return 1; else return -1; */ /* 3/24/99 - changed to always return 1, otherwise reports an error (what was I thinking of?), check spawn_status (!spawn) for result */ return 1; } /*------------------------------------------------------------------------- */ int ana_diskspace(narg, ps) /* return space on filesystem */ /* 3/28/98 - modified to work on several systems, some minor differences */ int narg, ps[]; /* diskspace('filesys') returns space left (probably in Kbytes) for file system (string) */ /* originally adapted from a routine of Wang Wei's used in the Kodak camera program but that one used ustat which confused things for years */ { char *filesys; int i, iq; float xq; #if defined(SOLARIS) struct statvfs statbuf; #else struct statfs statbuf; #endif if ( sym[ ps[0] ].class != 2 ) return execute_error(70); filesys = (char *) sym[ps[0] ].spec.array.ptr; /* get disk free space */ #if NeXT | __FreeBSD__ | defined(LINUX) | __APPLE__ if (statfs(filesys, &statbuf)) { perror("statfs"); return -1; } #endif #if defined(__alpha) if (statfs(filesys, &statbuf, sizeof(statbuf))) { perror("statfs"); return -1; } #endif #if defined(__sgi) if (statfs(filesys, &statbuf, sizeof(statbuf), 0)) { perror("statfs"); return -1; } #endif #if defined(SOLARIS) if (statvfs(filesys, &statbuf)) { perror("statvfs"); return -1; } #endif i = scalar_scratch(2); #if defined(__sgi) /* unfortunately, the SGI just has the free block count, not the available, this may mislead the user since only the superuser can use all of these */ xq = (float) statbuf.f_bfree * (float) statbuf.f_bsize/ 1024.; #else xq = (float) statbuf.f_bavail * (float) statbuf.f_bsize/ 1024.; #endif sym[i].spec.scalar.l = (int) xq; return i; } /*------------------------------------------------------------------------- */ int ana_filesize(narg, ps) /* return size of a file */ int narg, ps[]; /* filesize('name') returns size of file in bytes */ /* remove error message to make this more useful for determining if a file just exists */ { char *file; int i; struct stat statbuf; i = scalar_scratch(2); sym[i].spec.scalar.l = -1; if ( sym[ ps[0] ].class != 2 ) { execute_error(70); return i; } file = (char *) sym[ps[0] ].spec.array.ptr; if( stat(file, &statbuf)) { /*perror("stat");*/ return i; } sym[i].spec.scalar.l = statbuf.st_size; return i; } /*------------------------------------------------------------------------- */ #if LINUX | __FreeBSD__ int filesize(name) /* return size of a file */ char *name; /* filesize('name') returns size of file in bytes */ { int i = 0; struct stat statbuf; if( stat(name, &statbuf)) { perror("stat"); return 0; } i = statbuf.st_size; return i; } #else off64_t filesize64(name) /* return size of a file */ char *name; /* filesize('name') returns size of file in bytes */ { off64_t i = 0; struct stat64 statbuf; //printf("name in filesize64: %s\n", name); if( stat64(name, &statbuf)) { perror("stat"); return 0; } i = statbuf.st_size; return i; } #endif /*------------------------------------------------------------------------- */ int ana_filemtime(narg, ps) /* return the mtime of a file */ int narg, ps[]; /* filemtime('name') returns the mtime of a file in seconds */ { char *file; int i; struct stat statbuf; i = scalar_scratch(4); sym[i].spec.scalar.d = -1.0; if ( sym[ ps[0] ].class != 2 ) { execute_error(70); return i; } file = (char *) sym[ps[0] ].spec.array.ptr; if( stat(file, &statbuf)) { /*perror("stat");*/ return i; } sym[i].spec.scalar.d = #if defined(__alpha) | defined(LINUX) | defined(SOLARIS) | __APPLE__ (double) statbuf.st_mtime; #endif #if defined(__sgi) (double) statbuf.st_mtim.tv_sec + 1.E-9 * statbuf.st_mtim.tv_nsec; #endif #if defined(__FreeBSD__) /* 6/26/2003 - the E-9 was E9 below!, not sure the nsec is really valid */ (double) statbuf.st_mtimespec.tv_sec + 1.E-9*statbuf.st_mtimespec.tv_nsec; #endif return i; } /*------------------------------------------------------------------------- */ int ana_chdir(narg, ps) /* change default directory */ int narg, ps[]; { char *p; /* uses chdir call to change to path in string input */ if ( sym[ ps[0] ].class != 2 ) return execute_error(70); p = (char *) sym[ps[0] ].spec.array.ptr; if (chdir(p) == 0) return 1; else { perror("chdir"); return -1; } } /*------------------------------------------------------------------------- */ int ana_mkdir(narg, ps) /* make a new directory */ int narg, ps[]; { char *p; int mode; /* uses mkdir call */ if ( sym[ ps[0] ].class != 2 ) return execute_error(70); if (narg < 2) mode = 05 + 070 + 0700; else mode = int_arg(ps[1]); p = (char *) sym[ps[0] ].spec.array.ptr; /* 7/30/96, don't want to return an error (-1) when directory already exists, so for a quick patch, don't ever return an error */ if (mkdir(p, mode) == 0) return 1; else { perror("mkdir"); return 1; } } /*------------------------------------------------------------------------- */ int ana_getenv(narg, ps) /* return env var string */ int narg, ps[]; { char *env, *p, *q; int result_sym, mq; if ( sym[ ps[0] ].class != 2 ) return execute_error(70); p = (char *) sym[ps[0] ].spec.array.ptr; env = getenv(p); if (env == NULL) mq = 0; else mq = strlen(env); result_sym = string_scratch(mq); /*for resultant string */ q = (char *) sym[result_sym].spec.array.ptr; if (env == NULL) *q = 0; else strcpy(q, env); return result_sym; } /*------------------------------------------------------------------------- */ char *file_find(sdir, fname) char *sdir, *fname; { /* find a file given a starting directory, checks all sub-directories */ DIR *dirp; #if NeXT struct direct *dp; #else struct dirent *dp; #endif struct stat statbuf; int n, mq; char *sq, *s2, *s3; n = strlen(fname); /* printf("find_file, sdir: %s, fname: %s\n", sdir, fname); */ dirp = opendir(sdir); /* open directory */ if (!dirp) return NULL; /* can't read directory or something, not found */ while ((dp = readdir(dirp)) != NULL) { /* printf("dp->d_name: %s\n", dp->d_name); */ if (strcmp(dp->d_name, ".") == 0) continue; if (strcmp(dp->d_name, "..") == 0) continue; /* if (dp->d_namlen == n && !strcmp(dp->d_name, fname)) { */ if (!strcmp(dp->d_name, fname)) { closedir(dirp); /* got it !, make the whole name */ mq = n + strlen(sdir) + 2; sq = (char *) malloc(mq); strcpy(sq, sdir); strcat(sq, "/"); strcat(sq, fname); /* a few things that we could make optional, first replace a leading . with the full default path */ if (sq[0] == '.') { s2 = (char *) malloc(2048); getcwd(s2,2048); n = strlen(s2); mq = n + strlen(sq) + 1; s3 = (char *) malloc(mq); strcpy(s3, s2); strcat(s3, sq + 1); free(s2); free(sq); sq = s3; } //printf("got it, final name = %s\n", sq); return sq; } /* append the file */ mq = strlen(dp->d_name) + strlen(sdir) + 3; sq = (char *) malloc(mq); /* put in a /, extras are OK if there was one already */ strcpy(sq, sdir); strcat(sq, "/"); strcat(sq, dp->d_name); /* stat the combined file name and check if a directory */ /* printf("checking if %s is a directory\n", sq); */ if( stat(sq, &statbuf)) { printf("stat error for file: %s\n", sq); } else if ( (statbuf.st_mode & S_IFMT) == S_IFDIR) { /* got a directory */ /* add a '/' to the name */ /* strcat(sq, "/"); */ /* printf("got a directory: %s\n", sq); */ /* and call ourselves for the next level */ s2 = file_find(sq, fname); /* did we find it down there ? */ if (s2) { free(sq); closedir(dirp); return s2; } } /* no joy, free sq */ free(sq); } closedir(dirp); return NULL; } /*------------------------------------------------------------------------- */ char *file_path_find(path, fname) /* search a path set for a file */ char *path, *fname; /* this is unfinished, intended to search a series of paths */ { /* find a file called fname given a path set in path */ DIR *dirp; struct direct *dp; struct stat statbuf; int n, mq, np; char *sq, *s2, *p, *p2; n = strlen(fname); printf("file_path_find, path: %s, fname: %s\n", path, fname); /* decompose the path, if null we do the current */ p = path; while (1) { p2 = p; np = 0; while (*p2) { if (*p2++ == ':') break; np++;} mq = np + n + 2; sq = (char *) malloc(mq); strncpy(sq, p, np); *(sq+np) = 0; if (np && (*(sq+np-1) != '/') ) strcat(sq,"/"); strcat(sq, fname); printf("looking for: %s\n", sq); p = p2; if (!*p) break; } return sq; } /*------------------------------------------------------------------------- */ int ana_pathsearch(narg, ps) /* find a file given a path set */ int narg, ps[]; /* this is unfinished, intended to search a series of paths */ { char *path, *fname, *pq; int ns, result_sym; /* first argment is a string with the start path */ if ( sym[ ps[0] ].class != 2 ) return execute_error(70); path = (char *) sym[ps[0] ].spec.array.ptr; /* second is the file name */ if ( sym[ ps[1] ].class != 2 ) return execute_error(70); fname = (char *) sym[ps[1] ].spec.array.ptr; /* check if file name has any /'s in it, we want it to be simple */ if ( (pq = strchr(fname, '/')) != 0) { printf("WARNING - path stripped from file name input to pathsearch\n"); printf("input name: %s becomes %s\n", fname, pq); fname = pq; } pq = file_path_find(path, fname); /* pq will have the entire path+name if it was found */ if (pq == NULL) return 0; /* return symbol for 0 */ ns = strlen(pq); result_sym = string_scratch(ns); strcpy( (char *) sym[result_sym].spec.array.ptr, pq); free(pq); return result_sym; } /*------------------------------------------------------------------------- */ int ana_findfile(narg, ps) /* find a file given a starting path */ /* call is: name = findfile(start_path, name) */ int narg, ps[]; { char *startpath, *fname, *pq, *current_dir = "."; int ns, result_sym; /* first argment is a string with the start path */ if ( sym[ ps[0] ].class != 2 ) return execute_error(70); startpath = (char *) sym[ps[0] ].spec.array.ptr; if (strlen(startpath) <= 0) startpath = current_dir; /* second is the file name */ if ( sym[ ps[1] ].class != 2 ) return execute_error(70); fname = (char *) sym[ps[1] ].spec.array.ptr; /* check if file name has any /'s in it, we want it to be simple */ if ( (pq = strchr(fname, '/')) != 0) { printf("WARNING - path stripped from file name input to findfile\n"); printf("input name: %s becomes %s\n", fname, pq); fname = pq; } pq = file_find(startpath, fname); /* pq will have the entire path+name if it was found */ if (pq == NULL) return 0; /* return symbol for 0 */ ns = strlen(pq); result_sym = string_scratch(ns); strcpy( (char *) sym[result_sym].spec.array.ptr, pq); free(pq); return result_sym; } /*------------------------------------------------------------------------- */ int ana_getmatchedfiles(narg, ps) /* get all file names that match */ /* call is: strings = getmatchedfiles( expr, path, [maxfiles] ) */ /* uses regular expression matches, not the more familiar shell wildcarding, this is more general but not as intuitive, it uses the Unix routines regcomp and regexec used to be re_comp and re_exec */ int narg, ps[]; { int result_sym; char *s; /* the first arg is the regular expression string */ if ( sym[ ps[0] ].class != 2 ) return execute_error(70); s = (char *) sym[ps[0] ].spec.array.ptr; /* printf("expression: %s\n", s); */ #if defined(__alpha) | defined(LINUX) | defined(SOLARIS) | defined(__APPLE__) if (regcomp(&re,s,REG_EXTENDED|REG_NOSUB) ) { #else if (regcomp(&re,s,REG_EXTENDED|REG_NOSUB) ) { #endif printf("GETMATCHEDFILES - error in regular expression: %s\n", s); regfree(&re); return -1; } match_flag = 1; result_sym = ana_getfiles(narg-1, &ps[1]); match_flag = 0; regfree(&re); return result_sym; } /*------------------------------------------------------------------------- */ int ana_getmatchedfiles_r(narg, ps) /* also search subdir */ /* finds all file names that match in starting path and all sub-directories*/ /* call is: strings = getmatchedfiles_r( expr, path, [maxfiles] ) */ int narg, ps[]; { int result_sym; recursive_flag = 1; result_sym = ana_getmatchedfiles(narg, ps); recursive_flag = 0; return result_sym; } /*------------------------------------------------------------------------- */ int file_get(startpath) char *startpath; { int mq, iq, matches; char *sq; struct stat statbuf; DIR *dirp; #if NeXT struct direct *dp; #else struct dirent *dp; #endif dirp = opendir(startpath); /* open directory */ if (!dirp) { /* can't read directory or something, not found */ printf("GETFILES - can't read directory: %s\n", startpath); /* closedir(dirp); */ return 1; } /* go on, this happens a lot when searching */ while ((dp = readdir(dirp)) != NULL) { /* printf("dp->d_name: %s\n", dp->d_name); */ if (strcmp(dp->d_name, ".") == 0) continue; if (strcmp(dp->d_name, "..") == 0) continue; /* we don't stat the file unless we have to, we have to if it is a potential match or if we are checking for sub-directories */ /* are we matching to a regular expression ? */ matches = 1; /* everybody a match for get all case */ if (match_flag) { /* apparently, check if we match */ if(regexec(&re,dp->d_name,0,NULL,0)==0) matches = 1; else matches = 0; if (!matches && !recursive_flag) continue; } /* make a full path to file so we can stat it */ mq = strlen(dp->d_name) + strlen(startpath) + 2; sq = (char *) malloc(mq); /* put in a /, extras are OK if there was one already */ strcpy(sq, startpath); strcat(sq, "/"); strcat(sq, dp->d_name); /* printf("checking if %s is a regular file\n", sq); */ if( stat(sq, &statbuf)) { printf("GETFILES - stat error for file: %s\n", sq); } else /* check if a directory */ if ( recursive_flag && (statbuf.st_mode & S_IFMT) == S_IFDIR) { /* and call ourselves for the next level */ if (file_get(sq) != 1) { closedir(dirp); return -1; } } else if ( matches && (statbuf.st_mode & S_IFMT) == S_IFREG) { nfiles++; /* printf("nfiles = %d\n", nfiles); */ if (nfiles >= max) { nfiles--; printf("GETFILES - found too many files, max = %d\n", max); free(sq); break; } *p++ = sq; } else free(sq); } closedir(dirp); return 1; } /*------------------------------------------------------------------------- */ int directs_get(startpath) /* problems with the Sun version reading directories at cfa.harvard.com, using a readdir64 fixes it. The problem was a NULL return from readdir before all directories were read. Also get a sat error on some after the fix. But they seem to be OK? Try avoiding the stat and type check and just take whatever */ char *startpath; { int mq, iq, matches, i; char *sq; struct stat statbuf; DIR *dirp; #if NeXT struct direct *dp; #else #if defined(SOLARIS) struct dirent64 *dp; #else struct dirent *dp; #endif #endif printf("**** starting directs_get\n"); dirp = opendir(startpath); /* open directory */ if (!dirp) { /* can't read directory or something, not found */ fprintf(stderr, "**** GETFILES - can't read directory: %s\n", startpath); printf("**** GETFILES - can't read directory: %s\n", startpath); /* closedir(dirp); */ return 1; } /* go on, this happens a lot when searching */ printf("directs_get did opendir\n"); i = 0; #if SOLARIS while ((dp = readdir64(dirp)) != NULL) #else while ((dp = readdir(dirp)) != NULL) #endif { printf("**** dp->d_name: %s\n", dp->d_name); if (strcmp(dp->d_name, ".") == 0) continue; if (strcmp(dp->d_name, "..") == 0) continue; /* we have to stat the file since we are checking for sub-directories */ /* make a full path to file so we can stat it */ mq = strlen(dp->d_name) + strlen(startpath) + 2; sq = (char *) malloc(mq); /* put in a /, extras are OK if there was one already */ strcpy(sq, startpath); strcat(sq, "/"); strcat(sq, dp->d_name); if ( stat(sq, &statbuf)) { printf("**** GETFILES - stat error for file: %s\n", sq); } else /* check if a directory */ if ( (statbuf.st_mode & S_IFMT) == S_IFDIR) { nfiles++; if (nfiles >= max) { nfiles--; fprintf(stderr,"**** GETFILES - found too many directories, max = %d\n", max); free(sq); break; } /* for directories, we don't really want to pass the whole path to the usr (he/she already has the starting path anyhow) but we want to attach a / to the end */ free(sq); mq = strlen(dp->d_name) + 2; sq = (char *) malloc(mq); strcpy(sq, dp->d_name); strcat(sq, "/"); *p++ = sq; } else free(sq); } closedir(dirp); return 1; } /*------------------------------------------------------------------------- */ int ana_getfiles_r(narg, ps) /* also search subdir */ /* call is: strings = getfiles_r( path, [maxfiles] ) */ int narg, ps[]; { int result_sym; recursive_flag = 1; result_sym = ana_getfiles(narg, ps); recursive_flag = 0; return result_sym; } /*------------------------------------------------------------------------- */ int ana_getfiles(narg, ps) /* get all file names in directory */ int narg, ps[]; /* call is: strings = getfiles( path, [maxfiles] ) */ { char *startpath; int ns, result_sym, mq, iq, malloc_flag = 0, status; size_t dim[1]; char **names, **freenames; struct ahead *h; /* first argument is a string with the start path */ if ( sym[ ps[0] ].class != 2 ) return execute_error(70); startpath = (char *) sym[ps[0] ].spec.array.ptr; nfiles=0; /* the second optional arg. is the max # of files to find */ max = 500; if (narg > 1) if (int_arg_stat(ps[1], &max) != 1) return -1; /* get space to store pointers to copies of names, use SCRAT if big enough */ mq = max * sizeof (char *); /* printf("mq = %d, NSCRAT * sizeof(int) = %d\n", mq, NSCRAT * sizeof(int));*/ if (mq <= NSCRAT * sizeof(int) ) names = (char **) scrat; else { malloc_flag = 1; //printf("too big for SCRAT\n"); if ( (names = (char **) malloc(mq)) == NULL ) { printf("GETFILES - malloc failure for names array pointer, max = %d\n",max); return -1; } } freenames = p = names; if (get_type_flag == 0) status = file_get(startpath); else status = directs_get(startpath); printf("status value returned = %d\n", status); /* reset the flag to default here so we needn't do it in getdirectories */ get_type_flag = 0; if (status == 1) { /* make a strarr to match # of found files */ printf("nfiles = %d\n", nfiles); if (nfiles <= 0) { printf("GETFILES - no files found\n"); return 0; } *dim = nfiles; result_sym = strarr_scratch(1, dim); h = (struct ahead *) sym[result_sym].spec.array.ptr; p = (char **) ((char *)h + sizeof(struct ahead)); while (nfiles--) *p++ = *names++; } else result_sym = 0; /* error case */ if (malloc_flag) free(freenames); return result_sym; } /*------------------------------------------------------------------------- */ int ana_getdirectories(narg, ps) /* get all subdirectories in directory */ int narg, ps[]; /* call is: strings = getdirectories( path, [maxfiles] ) */ { /* very similar to getfiles, just set a flag here */ get_type_flag = 1; return ana_getfiles(narg, ps); } /*------------------------------------------------------------------------- */ int sblib(s,mode) /* function/routine library search */ char *s; int mode; { extern char *strsave(); extern int single_string_parse_flag; char *ss, *p1, *p2, *ana_slib; char line[256]; FILE *fin, *save_anain; int nsym, save_flag, n; //printf("open files (slib start) = %d\n", getdtablehi()); ss = strsave(s); p1 = s; p2 = ss; /* name will be upper case but want lower case for file name */ while (*p1) { *p2++ = isupper( (int) *p1 ) ? tolower( (int) *p1++) : *p1++; } fin = NULL; if (ulib_path) { switch (mode) { case 1: sprintf(line,"%s/%s_f.ana",ulib_path, ss); break; case 0: sprintf(line,"%s/%s.ana",ulib_path, ss); break; } fin = fopen(line,"r"); } if ( fin == NULL) { /* not in ulib (or no ulib), look for env variable ANA_SLIB */ ana_slib = getenv("ANA_SLIB"); if (ana_slib != NULL) { switch (mode) { case 1: sprintf(line,"%s/%s_f.ana",ana_slib, ss); break; case 0: sprintf(line,"%s/%s.ana",ana_slib, ss); break; } fin = fopen(line,"r"); } if (fin == NULL ) { /* if there is still none, try the fixed destinations */ switch (mode) { #if defined(NeXT) case 1: sprintf(line,"/me/ana/slib/%s_f.ana",ss); break; case 0: sprintf(line,"/me/ana/slib/%s.ana",ss); break; #endif #if defined(__sgi) case 1: sprintf(line,"/umbra/people/shine/ana/slib/%s_f.ana",ss); break; case 0: sprintf(line,"/umbra/people/shine/ana/slib/%s.ana",ss); break; #endif #if defined(__alpha) case 1: sprintf(line,"/usr/users/shine/ana/slib/%s_f.ana",ss); break; case 0: sprintf(line,"/usr/users/shine/ana/slib/%s.ana",ss); break; #endif } fin = fopen(line,"r"); } } /* did we ever find it ? */ if ( fin == NULL) { switch (mode) { case 0: printf("can't find subroutine %s in libraries\n", ss); case 1: printf("can't find function %s in libraries\n", ss); } free(ss); return -1; } /*printf("found it\n");*/ /*printf("checking name of function in sblib 1: %s\n", s );*/ save_anain = anain; //printf("open fin %d\n", fin); anain = fin; save_flag = single_string_parse_flag; single_string_parse_flag = 0; //printf("open files (slib pars) = %d\n", getdtablehi()); nsym=parser_imbedded(); single_string_parse_flag = save_flag; /* 3/3/2001 - found that these were never getting closed! Some changes made for the motif world caused me to remove or change code that once closed these back in anatest.c. Now I use a imbedded_parse_flag set in parser_imbedded to ensure that nextl will never close these (it could have if there was no end to a subr or func) and close it here. */ //printf("open files (slib fin) = %d\n", getdtablehi()); //printf("sblib closing fin %d\n", fin); fclose(fin); anain = save_anain; free(ss); //printf("open files (slib end) = %d\n", getdtablehi()); return 1; } /*------------------------------------------------------------------------- */ int ana_ulib(narg, ps) /*set ulib path */ int narg, ps[]; { extern char *strsave(); char *p1; if (narg == 0) { printf("current ulib path: %s\n", ulib_path); return 1; } if (ulib_path != NULL) free(ulib_path); if ( sym[ ps[0] ].class != 2 ) return execute_error(70); ulib_path = strsave( (char *) sym[ps[0] ].spec.array.ptr); return 1; } /*------------------------------------------------------------------------- */ int ana_type(narg, ps) /* (stdin) printing */ int narg, ps[]; { FILE *fp; fp = stdout; return type_ascii(narg, ps, fp); } /*------------------------------------------------------------------------- */ int ana_printf(narg, ps) /* file (stdin) reading and formatting */ int narg, ps[]; { FILE *fp; lun = int_arg( ps[0] ); if ( lun < 0 || lun >= MAXFILES) return execute_error(85); if ( ana_file_open[lun] == 0 ) return execute_error(94); if ( ana_file_open[lun] != 2 ) return execute_error(106); fp = ana_file[lun]; return type_ascii(narg - 1, &ps[1], fp); } /*------------------------------------------------------------------------- */ int ana_printf_f(narg, ps) /* a function version that returns 1 if read OK */ int narg, ps[]; { if ( ana_printf(narg, ps) == 1 ) return 1; else return 4; } /*------------------------------------------------------------------------- */ int type_ascii(narg,ps,fp) /*type out the value of symbols in list */ int narg, ps[]; FILE *fp; { register int nelem; register union types_ptr p1; register int j; int i,k,iq,jq,nd,flag=0; struct ahead *h; char *ptr, **p; for (i=0;indim; nelem = 1; for (j=0;jdims[j]; /*# of elements */ ptr = (char *) h + sizeof( struct ahead ); jq = sym[iq].type; if (flag) fprintf(fp, "\n"); flag=0; /*print entire array, number per line depends on type */ switch (jq) { case 2: p1.l = (int *)ptr; k=8; for (j=0;jndim; nelem = 1; for (j=0;jdims[j]; /*# of elements */ p = (char **) ((char *)h + sizeof(struct ahead)); if (flag) fprintf(fp, "\n"); flag=0; for (j=0;jndim; nelem = 1; for (j=0;jdims[j]; /*# of elements */ ptr = (char *) h + sizeof( struct ahead ); jq = sym[iq].type; if (flag) fprintf(fp, "\n"); flag=0; /*print entire array, number per line depends on type */ switch (jq) { case 2: p1.l = (int *)ptr; k=8; for (j=0;j= MAXFILES) return execute_error(85); if ( ana_file_open[lun] ) fclose( ana_file[lun] ); ana_file_open[lun] = 0; } return 1; } /*------------------------------------------------------------------------- */ int ana_flush(narg,ps) /* flush buffered data */ int narg, ps[]; { int i; for (i=0;i= MAXFILES) return execute_error(85); if ( ana_file_open[lun] ) fflush( ana_file[lun] ); } return 1; } /*------------------------------------------------------------------------- */ int file_open_error() { printf("file name = %s\n", name); return execute_error(84); } /*------------------------------------------------------------------------- */ int lun_setup(narg,ps) /* used by open routines */ int narg, ps[]; { /* first arg. is the lun */ lun = int_arg( ps[0] ); if ( lun < 0 || lun >= MAXFILES) return execute_error(85); if ( ana_file_open[lun] ) return execute_error(86); /* already open ? */ /* file name is second, must be a string */ if ( sym[ ps[1] ].class != 2 ) return execute_error(70); name = (char *) sym[ps[1] ].spec.array.ptr; return 1; } /*------------------------------------------------------------------------- */ int ana_get_lun(narg,ps) /* a function, returns an available lun */ int narg, ps[]; { /* no arguments */ int lun, result_sym; for (lun = 0; lun < MAXFILES; lun++) { if ( ana_file_open[lun] == 0 ) { result_sym = scalar_scratch(2); sym[result_sym].spec.scalar.l = lun; return result_sym; } } /* couldn't find one, return a -1 */ return 2; } /*------------------------------------------------------------------------- */ int ana_openr_f(narg,ps) /* openr function */ /* intended mainly for reading ASCII files in old ANA, but may be useful for streams in general for UNIX version */ /* associates a file (or a stream) with a lun */ /* this is function version and returns success status, can be used to check if file exists */ int narg, ps[]; { if (lun_setup(narg,ps) != 1) return -1; /* try to open the file */ if ((ana_file[lun]=fopen(name,"r")) == NULL) { ana_file[lun] = 0; return 4; } /* returns a zero status */ //printf("open files (openr) = %d\n", getdtablehi()); ana_file_open[lun] = 1; /* the 1 means for read access */ return 1; /* symbol 1 is a 1 for success */ } /*------------------------------------------------------------------------- */ int ana_openw_f(narg,ps) /* openw function */ /* create for writing */ /* this is function version and returns success status, can be used to check if file can be created */ int narg, ps[]; { if (lun_setup(narg,ps) != 1) return 4; /* try to open the file */ if ((ana_file[lun]=fopen(name,"w")) == NULL) { ana_file[lun] = 0; return 4; } /* returns a zero status */ //printf("open files (openw) = %d\n", getdtablehi()); ana_file_open[lun] = 2; /* the 2 means for write access */ return 1; } /*------------------------------------------------------------------------- */ int ana_openu_f(narg,ps) /* openu function */ /* update */ /* this is function version and returns success status, can be used to check if file can be updated */ int narg, ps[]; { if (lun_setup(narg,ps) != 1) return 4; /* try to open the file */ if ((ana_file[lun]=fopen(name,"r+")) == NULL) { ana_file[lun] = 0; return 4; } /* returns a zero status */ //printf("open files (openu) = %d\n", getdtablehi()); ana_file_open[lun] = 2; /* the 2 means for write access */ return 1; } /*------------------------------------------------------------------------- */ int ana_opena_f(narg,ps) /* opena function */ /* update at end (append) */ /* this is function version and returns success status, can be used to check if file can be updated */ int narg, ps[]; { if (lun_setup(narg,ps) != 1) return 4; /* try to open the file */ if ((ana_file[lun]=fopen(name,"a")) == NULL) { ana_file[lun] = 0; return 4; } /* returns a zero status */ //printf("open files (opena) = %d\n", getdtablehi()); ana_file_open[lun] = 2; /* the 2 means for write access */ return 1; } /*------------------------------------------------------------------------- */ int ana_openr(narg,ps) /* openr subroutine */ /* intended mainly for reading ASCII files in old ANA, but may be useful for streams in general for UNIX version */ /* associates a file (or a stream) with a lun */ int narg, ps[]; { /* call the function form and check status */ if (ana_openr_f(narg,ps) != 1) return file_open_error(); return 1; } /*------------------------------------------------------------------------- */ int ana_openw(narg,ps) /* openw subroutine */ /* create for writing */ int narg, ps[]; { if (ana_openw_f(narg,ps) != 1) return file_open_error(); return 1; } /*------------------------------------------------------------------------- */ int ana_openu(narg,ps) /* openu subroutine */ /* update */ int narg, ps[]; { if (ana_openu_f(narg,ps) != 1) return file_open_error(); return 1; } /*------------------------------------------------------------------------- */ int ana_opena(narg,ps) /* opena subroutine */ /* update, write at end */ int narg, ps[]; { if (ana_opena_f(narg,ps) != 1) return file_open_error(); return 1; } /*------------------------------------------------------------------------- */ int ana_rewindf(narg,ps) /*rewind file subroutine */ int narg, ps[]; { FILE *fp; /* first arg. is the lun */ lun = int_arg( ps[0] ); if ( lun < 0 || lun >= MAXFILES) return execute_error(85); if ( ana_file_open[lun] == 0 ) { printf("WARNING - attempt to rewind a undefined file, lun =%d\n", lun); return 1; } fp = ana_file[lun]; fseek(fp, 0, 0); /* rewind it */ return 1; } /*------------------------------------------------------------------------- */ int ana_read(narg, ps) /* keyboard (stdin) reading and formatting */ int narg, ps[]; { FILE *fp; fp = stdin; return read_ascii(narg, ps, fp); } /*------------------------------------------------------------------------- */ int ana_readf(narg, ps) /* file (stdin) reading and formatting */ int narg, ps[]; { FILE *fp; if (int_arg_stat(ps[0], &lun) != 1) return -1; if ( lun < 0 || lun >= MAXFILES) return execute_error(85); if ( ana_file_open[lun] == 0 ) return execute_error(94); fp = ana_file[lun]; return read_ascii(narg - 1, &ps[1], fp); } /*------------------------------------------------------------------------- */ int ana_readf_f(narg, ps) /* a function version that returns 1 if read OK */ int narg, ps[]; { int iq; eof_noise_flag = 0; iq = ana_readf(narg, ps); eof_noise_flag = 1; if ( iq == 1 ) return 1; else return 4; } /*------------------------------------------------------------------------- */ int hit_eof() /* we may not want to make any noise about this */ { if (eof_noise_flag) return execute_error(91); return -1; } /*------------------------------------------------------------------------- */ int read_ascii(narg, ps, fp) /* read subroutine */ /* read ascii stream, format and load into passed arguments */ /* called by ana_read and ana_readf */ int narg, ps[]; FILE *fp; { int nelem; union types_ptr p1; union scalar xs, *xsp; int j, itype, type; int i, c, iq, jq, nd, flag=0, n; struct ahead *h; char *s, *p; /* loop over input args */ index_cnt = 0; i = 0; while (narg) { narg--; left_cnt = narg; index_cnt++; iq =ps[i]; type = sym[iq].type; //if (fp == stdin && type != 15) strcpy(prompt,"0> "); if (fp == stdin) strcpy(prompt," > "); switch ( sym[iq].class ) { case 1: if (get_val(fp, line) == EOF ) return hit_eof(); xsp = &xs; itype = decode_val(line, xsp, type); p1.l = &sym[iq].spec.scalar.l; ana_array_convert( &xsp, &p1.l, itype, type, 1); break; case 8: if (get_val(fp, line) == EOF ) return hit_eof(); xsp = &xs; itype = decode_val(line, xsp, type); p1.l = sym[iq].spec.array.ptr; ana_array_convert( &xsp, &p1.l, itype, type, 1); break; case 255: /* not defined, see what we get before defining as a scalar */ if (get_val(fp, line) == EOF ) return hit_eof(); xsp = &xs; itype = decode_val(line, xsp, -1); /* if a floating point or double value was found, make it the type, otherwise an int */ if (redef_scalar(iq, itype, xsp) != 1) return -1; break; case 2: /* string */ /* if a fixed string, type out rather than read in */ /* this allows in line prompting */ /* 10/30/96 bug: following statement had a > but needed a >= */ if (iq >= edb2_base) { if (fp == stdin) { printf("%s\n", (char *) sym[iq].spec.array.ptr); } break; } /* not a fixed string, read in */ /* read in to next newline and put result in string */ n = maxline; s = line; if (fp == stdin) { while ( n > 0 && (c=mygetchar()) != EOF && c != '\n') { *s++ = c; n--; } } else { while ( n > 0 && (c=getc(fp)) != EOF && c != '\n') { *s++ = c; n--; } } n = maxline - n; if ( c == EOF && s == line ) { /* EOF and no data */ return hit_eof(); } redef_string ( ps[i], n ); p = (char *) sym[ps[i] ].spec.array.ptr; s = line; while (n--) *p++ = *s++; *p = 0; /*load it */ break; case 4: /*array */ /* read in the whole array */ h = (struct ahead *) sym[iq].spec.array.ptr; p1.l = (int *) ((char *)h + sizeof(struct ahead)); nd = h->ndim; n = 1; for (j=0;jdims[j]; /* reset index_cnt to 0 so that it can be used to count array elements */ index_cnt = 0; /* now just loop over all the elements */ while (n) { n--; left_cnt = n; index_cnt++; if (get_val(fp, line) == EOF ) return hit_eof(); xsp = &xs; itype = decode_val(line, xsp, type); ana_array_convert( &xsp, &p1.l, itype, type, 1); /* note that ana_array_convert bumps p1 */ } } i++; } strcpy(prompt,"ANA>"); /* we have to clear out anything left over in the last line or it comes back for the next read */ myleftover = 0; return 1; } /*------------------------------------------------------------------------- */ int decode_val(s, xs, type ) char *s; int type; union scalar *xs; /* convert s to a binary scalar which is either integer or fp */ /* type (normally 2 or 3) is returned on success, -1 on error */ /* 4 returned if double */ /* if type is set to float or double, always read as such */ { int k; char *p; /* check if just a NULL and return a zero if so */ if (*s == 0) { switch (type) { case 0: case 1: case 2: xs->l = 0; return 2; case 3: xs->f = 0.0; return 3; case 4: xs->d = 0.0; return 4; }} p = s; if ( type > 2 ) { switch (type) { case 3: xs->f = atof(p); return 3; /* force floating */ case 4: while (*s) { if ( toupper(*s) == 'D' ) { *s = 'E'; break; } s++;} xs->d = atof(p); return 4; /* force double */ } } while (*s) { if ( isdigit(*s) == 0) { if ( *s == 'x' || *s == 'X' ) { /* check if a hex */ p = ++s; while (*s) if (isxdigit(*s++) == 0 ) { printf("error decoding %s\n", p); return -1; } errno = 0; xs->l = strtoul( p, (char **)NULL,16 ); if (errno > 0 ) perror("hex conversion error"); return 2; } /* try a floating point */ /*unless a D is found */ while (*s) { if ( toupper(*s) == 'D' ) { *s = 'E'; xs->d = atof (p ); return 4;} s++; } xs->f = atof( p ); return 3; } s++; } /* must all be digits ,try a %d */ xs->l = atol( p ); return 2; /* note that the returned type is not always the input type */ } /*------------------------------------------------------------------------- */ int mygetchar() { /* replaces the usual getchar, we do this to allow using nexttypedl */ extern char stdin_buf[]; static char *myptr; while (myleftover <= 0) { //printf("calling nexttypedl\n"); myleftover = nexttypedl(); //printf("myleftover = %d\n",myleftover); myptr = stdin_buf; //printf("myptr: %s\n", myptr); } myleftover--; return *myptr++; } /* -------------------------------------------------------------*/ int get_val(fp, s) FILE *fp; char *s; /* loads the string s with the next numerical token */ /* we want to allow reading several files at the same time (interleaved) so be careful of changes */ { int c; char *ss; char pbuf[32]; ss = s; *s = 0; if (fp == stdin) { /* use mygetchar to allow line editing and such, also means we don't have to change terminal characteristics, but still rather clumsy here */ /* first skip over any spaces */ while ( isspace( c = mygetchar() ) != 0 ) { ; } /* look for something meaningful and load s */ while ( 1 ) { if ( c == EOF ) break; if ( c == '\n' ) { /* some checks to see if we want a special prompt */ if ( left_cnt > 0 || *(s-1) == 0 || *(s-1) == ',' ) { sprintf(pbuf,"%d> ", index_cnt); strcpy(prompt, pbuf); } *s =0; return 1; } if ( c == ',' || isspace(c) ) { *s = 0; return 1; } *s++ = c; c = mygetchar(); } /* must have hit an EOF, did we get anything ? */ if (*ss == 0) return EOF; else return 1; } else { /* for file reads */ /* first skip over any spaces */ while ( isspace( c = getc(fp) ) != 0 ) { ; } /* look for something meaningful and load s */ while ( 1 ) { if ( c == EOF ) break; if ( c == '\n' ) { *s =0; return 1; } if ( c == ',' || isspace(c) ) { *s = 0; return 1; } *s++ = c; c = getc(fp); } /* must have hit an EOF, did we get anything ? */ if (*ss == 0) return EOF; else return 1; } } /*------------------------------------------------------------------------- */ int ana_assoc_input(narg, ps) /* use an associated variable as a guide to reading a file */ int narg, ps[]; { int iq, lun, type, j, n, recn, nd, result_sym; char *p; struct ahead *h; FILE *fp; /* called from subsc.c, args are sym # for assoc. var and the index */ if (narg != 2) return execute_error(112); recn = int_arg( ps[1] ); /* record number (0 is first) */ iq = ps[0]; h = (struct ahead *) sym[iq].spec.array.ptr; type = sym[iq].type; lun = h->c1; if ( lun < 0 || lun >= MAXFILES) return execute_error(85); if ( ana_file_open[lun] == 0 ) return execute_error(94); fp = ana_file[lun]; /* get size of each record which is also size to read */ nd = h->ndim; n = ana_type_size[type]; for(j=0;jdims[j]; } /* the starting offset is */ j = n * recn + h->c2; /* 8/15/94, added offset option in h->c2 */ /*printf("j,n,recn = %d %d %d\n", j,n,recn);*/ if ( fseek(fp, j, 0) == -1) execute_error(113); result_sym = array_scratch(type, nd, &h->dims[0]); h = (struct ahead *) sym[result_sym].spec.array.ptr; p = (char *) ((char *)h + sizeof(struct ahead)); /* now read the file */ if ( (j = fread(p, 1, n, fp)) != n ) { if ( j <= 0 ) return execute_error(113); printf("only %d bytes read for assoc. var %d bytes in size\n",j,n); } return result_sym; } /*------------------------------------------------------------------------- */ int ana_fileread(narg, ps) /* raw file read routine: fileread,lun,array,start,num,type */ /* the file must be opened with a lun, the start position and num are in units of the byte size for the data type (types 0 to 4 for I*1,I*2,I*4,F*4,F*8); i.e., if the type is 2 (I*4) then the file is read starting at address start*4 and num*4 bytes are read */ /* if start is <0, then we just read from current position */ int narg, ps[]; { int iq, lun, type, j, n, start, num, nd; extern void wait_sec(); extern int byte_count; char *p; struct ahead *h; FILE *fp; if (int_arg_stat(ps[0], &lun) != 1) return -1; if ( lun < 0 || lun >= MAXFILES) return execute_error(85); if ( ana_file_open[lun] == 0 ) return execute_error(94); fp = ana_file[lun]; if (int_arg_stat(ps[2], &start) != 1) return -1;/* first element */ if (int_arg_stat(ps[3], &num) != 1) return -1;/* number */ if (int_arg_stat(ps[4], &type) != 1) return -1;/* type */ if (type < 0 || type >4) return execute_error(32); iq = ps[1]; nd = 1; dim[0] = num; if ( redef_array( iq, type, nd, dim) != 1 ) { return -1; } h = (struct ahead *) sym[iq].spec.array.ptr; p = (char *) ((char *)h + sizeof(struct ahead)); n = ana_type_size[type]; /* the starting offset is */ if (start >=0 ) { j = n * start; /*printf("j,n,recn = %d %d %d\n", j,n,recn);*/ if ( fseek(fp, j, 0) == -1) {perror("fileread"); return -1;} } /* now read the file */ n = n * num; if ( (j = fread(p, 1, n, fp)) != n ) { if ( j <= 0 ) return execute_error(113); printf("only got %d bytes in readfile, expected %d\n",j,n); /* sometimes (much too often!) a network problem, so try again */ wait_sec(10.0); printf("trying again for a complete read\n"); j = fread(p, 1, n, fp); if (j !=n) { /* still a problem */ printf("still short after 2 tries, got %d bytes\n", j); } } byte_count = j; return 1; } /*------------------------------------------------------------------------- */ int ana_filewrite(narg, ps) /* raw file write routine: fileread,lun,array,[start] */ /* the file must be opened with a lun, the start position and num are in units of the byte size for the data type (types 0 to 4 for I*1,I*2,I*4,F*4,F*8); i.e., if the type is 2 (I*4) then we write starting at address start*4 and num*4 bytes are read */ /* if there is no start argument, we just write from wherever the file pointer is, there is no fseek */ int narg, ps[]; { int iq, lun, type, j, n, start, num, nd, typesize; char *p; struct ahead *h; FILE *fp; if (int_arg_stat(ps[0], &lun) != 1) return -1; if ( lun < 0 || lun >= MAXFILES) return execute_error(85); if ( ana_file_open[lun] == 0 ) return execute_error(94); fp = ana_file[lun]; iq = ps[1]; type = sym[iq].type; switch (sym[iq].class) { case 8: iq = class8_to_1(iq); /*scalar ptr case */ case 1: p = (char *) &sym[iq].spec.scalar.l; /*scalar case */ typesize = num = ana_type_size[type]; break; case 2: /*string */ p = (char *) sym[iq].spec.array.ptr; typesize = 1; num = sym[iq].spec.array.bstore - 1; /*don't include the null */ break; case 4: /*array case */ h = (struct ahead *) sym[iq].spec.array.ptr; p = (char *) ((char *)h + sizeof(struct ahead)); typesize = num = ana_type_size[type]; nd = h->ndim; for(j=0;jdims[j]; } break; default: case 255: return execute_error(53); } if (num <= 0) return 1; start = -1; if (narg > 2) { if (int_arg_stat(ps[2], &start) != 1) return -1; } /* the starting offset is */ if (start >= 0 ) { j = typesize * start; /*printf("j,n,start = %d %d %d\n", j,n, start);*/ if ( fseek(fp, j, 0) == -1) {perror("filewrite"); return -1;} } /* now write the file */ if ( (j = fwrite(p, 1, num, fp)) != num ) { if ( j <= 0 ) return execute_error(113); printf("only got %d bytes in writefile, expected %d\n",j,num); } return 1; } /*------------------------------------------------------------------------- */ int ana_assoc_output(iq, jq, recsym) /* use an associated variable as a guide to writing into a file */ /* iq is sym # of assoc var, jq is rhs sym with data, recn is sym # */ int iq, jq, recsym; { int lun, type, j, n, nd, nrhs, recn; char *p; struct ahead *h; FILE *fp; if ( sym[recsym].class != 1 && sym[recsym].class != 8) return execute_error(10); recn = int_arg( recsym ); /* record number (0 is first) */ h = (struct ahead *) sym[iq].spec.array.ptr; type = sym[iq].type; lun = h->c1; if ( lun < 0 || lun >= MAXFILES) return execute_error(85); if ( ana_file_open[lun] == 0 ) return execute_error(94); if ( ana_file_open[lun] != 2 ) return execute_error(106); fp = ana_file[lun]; /* get size of each record which is also size to write */ nd = h->ndim; n = ana_type_size[type]; for(j=0;jdims[j]; } /* the starting offset is */ j = n * recn + h->c2; /* 8/15/94, added offset option in h->c2 */ /*printf("j,n,recn = %d %d %d\n", j,n,recn);*/ if ( fseek(fp, j, 0) == -1) execute_error(113); /* check out the rhs now */ if ( sym[jq].class != 4 && n != 1) return execute_error(114); h = (struct ahead *) sym[jq].spec.array.ptr; nd = h->ndim; nrhs = ana_type_size[type]; /* not the type for jq but for iq */ /* total # of elements must match, but different dimensions OK */ for(j=0;jdims[j]; } if ( n != nrhs) return execute_error(114); /* convert rhs if necessary */ if (type != sym[jq].type) { switch (type) { case 0: jq = ana_byte(1,&jq); break; case 1: jq = ana_word(1,&jq); break; case 2: jq = ana_long(1,&jq); break; case 3: jq = ana_float(1,&jq); break; case 4: jq = ana_double(1,&jq); break; } } h = (struct ahead *) sym[jq].spec.array.ptr; p = (char *) ((char *)h + sizeof(struct ahead)); /* now write the file */ if ( (j = fwrite(p, 1, n, fp)) != n ) { if ( j <= n ) return execute_error(115); printf("only %d bytes written for assoc. var %d bytes in size\n",j,n); } return 1; } /*------------------------------------------------------------------------- */ FILE *fopenr_sym(nsym) /* internal utility */ /* decode an ana string symbol and use as a file name to open a file for read, 1/17/99 */ int nsym; { FILE *fopen(),*fin; if ( sym[nsym].class != 2 ) { execute_error(70); return NULL; } name = (char *) sym[nsym].spec.array.ptr; /* try to open the file */ if ((fin=fopen(name,"r")) == NULL) { file_open_error(); return NULL; } //printf("open files (openr_sym) = %d\n", getdtablehi()); return fin; } /*------------------------------------------------------------------------- */ int ck_synch_hd(fin, fh, p, wwflag) /* internal utility */ /* reads the start of an fz file, checks for synch and a reasonable header, returns -1 if something amiss, used by several fz readers */ FILE *fin; struct fzhead *fh; char **p; int *wwflag; { if (fread(fh,1,512,fin) != 512) { perror("fzread in header"); } #if defined(LITTLEENDIAN) if (fh->synch_pattern != 0x5555aaaa) { if (fh->synch_pattern == 0xaaaa5555) { #else if (fh->synch_pattern != 0xaaaa5555) { if (fh->synch_pattern == 0x5555aaaa) { #endif printf("reversed F0 synch pattern, assuming wwflag\n"); *wwflag = 1; } else { printf("file does not have the F0 synch pattern %x\n",fh->synch_pattern); fclose(fin); return -1; } } /* if the header is long, read in the rest now */ if (fh->nhb > 1 ) { if (fh->nhb > 15) { printf("header more than 16 blocks ! Cannot handle it!\n"); fclose(fin); return -1; } fread((char *) fh + sizeof(struct fzhead),1,512*(fh->nhb-1),fin); } *p = (char *) fh->txt; #if defined(LITTLEENDIAN) #else swapl(&fh->dim[0],(int) fh->ndim); /* for BIGENDIAN machines (SGI) */ #endif return 1; } /*------------------------------------------------------------------------- */ void fz_get_header(p, nsym, n) /* internal utility */ char *p; int nsym; int n; { char *q; int nc = 0; q = p; while (n--) { if ( *p++ == 0 ) break; nc++; } /* count to null */ redef_string ( nsym, nc ); p = (char *) sym[nsym].spec.array.ptr; while (nc--) *p++ = *q++; *p = 0; /*load it */ } /*------------------------------------------------------------------------- */ void fz_print_header(p, n) /* internal utility */ char *p; int n; { while (n--) { putchar(isprint(*p) ? *p : ' '); if (*p == 13) putchar('\n'); if (*p++ == 0 ) break; } putchar('\n'); } /*------------------------------------------------------------------------- */ int ana_fzinspect(narg,ps) /* fzinspect subroutine */ /* return some info about an fz file */ /* subr version, fzinspect(name, param, [header]) where name is the file name, param is an I*4 array containing the following: filesize (-1 if no file), variable type, ndim, dim(1 to 8) the header is optionally returned fzinspect usually returns with a "success" (unless file name is not a string) and user must check param(0) to see if file was actually readable */ int narg, ps[]; { int iq, n, wwflag=0, *q1, i; char *p, *q; struct ahead *h; struct fzhead *fh; FILE *fin; struct stat statbuf; /* define the return variable param, a long vector with 11 elements */ /* pre-load with error condition in case we have a problem reading the file */ i = 11; if ( redef_array( ps[1], 2, 1, &i) != 1 ) { fclose(fin); return -1; } h = (struct ahead *) sym[ps[1]].spec.array.ptr; q1 = (int *) ((char *)h + sizeof(struct ahead)); q1[0] = -1; for (i=1;i<11;i++) q1[i] = 0; /* try to open the file */ if ((fin=fopenr_sym(ps[0])) == NULL) return -1; /* a few chores, check the synch and get a pointer to header */ /* use scrat to read in header block */ fh = (struct fzhead *) scrat; if (ck_synch_hd(fin, fh, &p, &wwflag) < 0 ) return 1; n = 256 + 512*(fh->nhb-1); /* if a header requested, create and load */ if (narg > 2) fz_get_header(p, ps[2], n); else fz_print_header(p, n); if( (stat(name, &statbuf)) != 0) { perror("stat"); return 1; } q1[0] = statbuf.st_size; q1[1]= fh->datyp; q1[2] = fh->ndim; read_file_class = fh->file_class; for (i=0;indim;i++) { q1[i+3]= fh->dim[i];} fclose(fin); return 1; } /*------------------------------------------------------------------------- */ int sym_desc_out(fout, pdesc, offset) FILE *fout; struct sym_desc *pdesc; int offset; { /* emit the essense of a symbol descriptor to file fout, pad to 16 bytes */ int j, nb, iq; short sq; byte bq, x[4]; static int extra = (int) (40 - sizeof(struct ahead)); int class; //printf("extra = %d\n", extra); nb = 1; /* check the writes but not every one */ j = fwrite(&pdesc->class, 1, nb, fout); j = fwrite(&pdesc->type, 1, nb, fout); if (j != nb) return 1; /* the next part is a short, always write out big endian style */ sq = pdesc->xx; bq = (byte) ( sq >> 8); j = fwrite(&bq, 1, nb, fout); bq = (byte) (sq & 0xff); j = fwrite(&bq, 1, nb, fout); if (j != nb) return 1; /* that's only 4 bytes so far, now a 4 byte gap because the SGI did it that way when writing a sym_desc, an alignment thing */ iq = 0; nb = 4; j = fwrite(&iq, 1, nb, fout); /* and write the offset out, big endian style */ x[0] = (byte) (offset >> 24); x[1] = (byte) (offset >> 16); x[2] = (byte) (offset >> 8); x[3] = (byte) (offset); j = fwrite(x, 1, nb, fout); /* and the bstore, but need to add "extra" if an array (almost always is) */ iq = pdesc->spec.array.bstore; class = pdesc->class; if (class == ARRAY || class == STRING_PTR ) iq = iq + extra; /* extra could be negative for some machines */ x[0] = (byte) (iq >> 24); x[1] = (byte) (iq >> 16); x[2] = (byte) (iq >> 8); x[3] = (byte) (iq); j = fwrite(x, 1, nb, fout); if (j != nb) return 1; return 0; } /*------------------------------------------------------------------------- */ int ana_fzhead(narg,ps) /* fzhead subroutine */ /* read header in fz files */ /* PROCEDURE -- Called by: FZHEAD,'FILENAME' [,TEXT HEADER]*/ int narg, ps[]; { int iq, n, wwflag=0; char *p; struct fzhead *fh; FILE *fin; if ((fin=fopenr_sym(ps[0])) == NULL) return -1; /* a few chores, check the synch and get a pointer to header */ /* use scrat to read in header block */ fh = (struct fzhead *) scrat; if (ck_synch_hd(fin, fh, &p, &wwflag) < 0 ) return -1; read_file_class = fh->file_class; n = 256 + 512*(fh->nhb-1); /* if a header requested, create and load */ if (narg > 1) fz_get_header(p, ps[1], n); else fz_print_header(p, n); fclose(fin); return 1; } /*------------------------------------------------------------------------- */ int ana_fzread(narg,ps) /* fzread subroutine */ /* read standard f0 files, compressed or not */ /* PROCEDURE -- Called by: FZREAD,VAR,'FILENAME' [,TEXT HEADER]*/ int narg, ps[]; { int iq, n, nb, nc, nd, j, type, i, mq, nq, sbit, nelem, wwflag=0; int bigendian, flip; char *p; struct ahead *h; struct fzhead *fh; union types_ptr q1; FILE *fin; struct compresshead { int tsize,nblocks,bsize; byte slice_size,type; } ch; union { int i; byte b[4];} lmap; /* an endian detector, taken from SL's tiff library */ { int one = 1; bigendian = (*(char *)&one == 0); } /* first arg is the variable to load, second is name of file */ if ((fin=fopenr_sym(ps[1])) == NULL) return -1; /* use scrat to read in header block */ fh = (struct fzhead *) scrat; if (ck_synch_hd(fin, fh, &p, &wwflag) < 0 ) return -1; type = fh->datyp; read_file_class = fh->file_class; /* endian flip flag, similar to LS's except for the names */ flip = (((fh->subf >> 7) & 1) ^ bigendian); /* compute size of array */ nelem=1; for (i=0;indim;i++) { nelem *= fh->dim[i];} n = 256 + 512*(fh->nhb-1); /* if a header requested, create and load */ if (narg > 2) fz_get_header(p, ps[2], n); else fz_print_header(p, n); iq = ps[0]; /* create the output array, include support for string arrays, not for compressed string arrays however */ /* also look for symbol arrays */ if (type == VAR_STRING) { char **q; /* because the string arrays are different, finish the whole thing up here and then return */ if (fh->subf & 1) { printf("fzread - compressed string arrays not supported\n"); fclose(fin); return -1; } if ( redef_strarr( iq, fh->ndim, fh->dim) != 1 ) { fclose(fin); return -1; } h = (struct ahead *) sym[iq].spec.array.ptr; q = (char **) ((char *) sym[iq].spec.array.ptr + sizeof(struct ahead)); n = nelem; while (n--) { /* read the count */ fread(&mq, sizeof(int), 1, fin); if (flip) swapl(&mq, 1); if (mq) { *q = malloc(mq + 1); if ( (*q) == NULL) { printf("fzread - malloc error for string array input\n"); fclose(fin); return -1; } if (fread(*q, 1, mq, fin) != mq) { printf("fzread - read error during string array input\n"); fclose(fin); return -1; } (*q)[mq] = '\0'; /* terminate */ q++; } } fclose(fin); return 1; /* finish up here for string arrays */ } /* symbol arrays have a type of MIXED_TYPES and a class */ if (type == MIXED_TYPES) { /* 11/25/2000 - to be able to read files from other machines, we can't use the sym_desc structure for the array of pointers and sizes since these can vary, some machines have I*4 pointers, others have I*8, and alignment rules are different. Becasue we started with an SGI and wrote some files before addressing this issue, the stored file format is consistent with the SGI structures. */ struct sym_desc *pbase, *pdesc; byte *pq_file, *p; int narr, class, *pint, nsize = 16, kq, head_size = 40, j, i; int extra = (int) (40 - sizeof(struct ahead)); struct ahead *h2; //printf("sizeof sym_desc = %d\n",sizeof(struct sym_desc)); //printf("sizeof ahead = %d\n",sizeof(struct ahead)); /* only thing legal here at present is a symarr, check class */ /* create the bare sym array */ if ( redef_symarr(iq, fh->ndim, fh->dim) != 1 ) { fclose(fin); return -1; } printf("symbol array created\n"); h = (struct ahead *) sym[iq].spec.array.ptr; pdesc = pbase = (struct sym_desc *) ((char *)h + sizeof(struct ahead)); /* allowing for different sym_desc sizes, need to allocate a seperate block for the stuff read in and then copy into the real sym_desc's */ pq_file = malloc( nelem * nsize); /* we have the (contiguous) memory allocation now for the descriptors and we can load them up from the file, the pointers in the file are file locations. These can be used to check the data reads or for randowm access. But we don't do that here. */ nb = nelem * nsize; /* total size */ if (fread(pq_file, 1, nb, fin) != nb) { execute_error(91); fclose(fin); return -1; } printf("nelem = %d\n", nelem); narr = nelem; while (narr--) { /* copy and convert from the file form of the sym_desc to a local (machine dependent) form of the sym_desc structure */ //printf("pointer in file %d\n", pdesc->spec.array.ptr); //printf("bstore in file %d\n", pdesc->spec.array.bstore); /* pre-zero each pointer in case there is a read failure */ /* the file offsets are not used here because we read everything */ pdesc->spec.array.ptr = NULL; pdesc->class = (byte) *pq_file++; pdesc->type = (byte) *pq_file++; kq = ((int) *pq_file++) << 8; kq = kq + *pq_file++; pdesc->xx = (short) kq; /* skip 8 bytes */ pq_file += 8; kq = ((int) *pq_file++) << 24; kq += ((int) *pq_file++) << 16; kq += ((int) *pq_file++) << 8; kq += ((int) *pq_file++); pdesc->spec.array.bstore = kq; //printf("class, type, bstore = %d %d %d\n", pdesc->class, pdesc->type,kq); /* the bstore may get adjusted later to accomondate the local size of ahead */ pdesc++; } narr = nelem; pdesc = pbase; while (narr--) { /* get memory and read each set of data */ nb = pdesc->spec.array.bstore; //printf("nb = %d\n", nb); class = pdesc->class; //printf("class = %d\n", class); /* for the ARRAY and STRING_PTR classes, we have a ahead structure that defines the dimensions */ if (class == ARRAY || class == STRING_PTR ) { /* the ahead stored has be converted to the local ahead structure, the stored version has a size of head_size bytes (40?)*/ p = (byte *) scrat; /* note use of scrat */ j = fread(p, 1, head_size, fin); /* check later for errors */ //printf("read %d\n", j); //for (i=0;i<40;i++) { //printf("%#x ", *(p+i) ); //} //printf("\nstart reformat\n"); /* compute size needed for array with local ahead */ nb = nb - extra; /* that is normally -40 + sizeof(struct ahead) */ pint = (int *) ((struct ahead *) malloc(nb)); if (pint == NULL) { execute_error(13); fclose(fin); return -1; } h2 = (struct ahead *) pint; h2->ndim = *p++; h2->c1 = *p++; h2->c2 = *p++; h2->c3 = *p++; /* the dimension values */ for (i=0;i<8;i++) { kq = ((int) *p++) << 24; kq += ((int) *p++) << 16; kq += ((int) *p++) << 8; kq += ((int) *p++); h2->dims[i] = kq; //printf("h2->dims[%d] = %d\n", i, kq); } /* always assume no "facts" stored */ h2->facts = NULL; /* now change pint to start of data for next read */ pint = (int *) ((char *) pint + sizeof(struct ahead)); /* reduce nb to actual data area for later read */ nb = nb - sizeof(struct ahead); //printf("shortened nb = %d\n", nb); } else if (class == STRING) { pint = (int *) malloc(nb); if (pint == NULL) { execute_error(13); fclose(fin); return -1; } h2 = (struct ahead *) pint; } else { printf("unsupported class (%d) in stored symbol array\n", class); fclose(fin); return -1; } /* read in the rest (or all of it if it wasn't an array */ //printf("nb to read %d, pint = %#x\n", nb, pint); if (fread(pint, 1, nb, fin) != nb) { execute_error(91); fclose(fin); return -1; } /* note that the pint and nb above must point to the data in an array for possible endian treatment below, be careful if changing code */ pdesc->spec.array.ptr = (int *) h2; /* the data may have been stored in a contrary endian */ /* so may have to flip if an array, need nb and pint for data and type */ //printf("flip = %d\n", flip); if (flip) { /* arrays of type 1 or higher */ if (class == ARRAY) { switch (pdesc->type) { case WORD: swapb((char *)pint, nb); break; case FLOAT: case LONG: swapl((int *)pint, nb/4); break; case DOUBLE: swapd((double *)pint, nb/8); break; } } } pdesc++; } /* and that's all for this proto-type version of sym array input */ fclose(fin); return 1; } nb = nelem * ana_type_size[type]; if ( redef_array( iq, type, fh->ndim, fh->dim) != 1 ) { fclose(fin); return -1; } h = (struct ahead *) sym[iq].spec.array.ptr; q1.l = (int *) ((char *)h + sizeof(struct ahead)); /* big branch on compression flag */ if (fh->subf & 1) { /* compression case */ /* read in the compression header */ nq=fread(&ch,1,14,fin); if (nq != 14) { perror("error reading in compression header"); } #if defined(LITTLEENDIAN) #else swapl(&ch.tsize,1); swapl(&ch.nblocks,1); swapl(&ch.bsize,1); #endif for (i=0;i<4;i++) lmap.b[i]=fh->cbytes[i]; #if defined(LITTLEENDIAN) #else swapl(&lmap.i,1); #endif mq = ch.tsize-14; if (mq <= NSCRAT) p = (char *) scrat; else { iq = string_scratch(mq); p = (char *) sym[iq].spec.array.ptr; } nq=fread(p, 1, mq, fin); if (nq != mq) perror("error reading in compressed data"); sbit=ch.slice_size; /* fix a problem with ch.nblocks */ if ( ch.bsize * ch.nblocks > nelem ) { printf("warning, bad ch.nblocks = %d\n", ch.nblocks); ch.nblocks = nelem / ch.bsize; printf("correcting to %d, hope this is right!\n", ch.nblocks); } /* some consistency checks */ if (ch.type%2 == type) { printf("inconsisent compression type\n"); return execute_error(3); } switch (ch.type) { case 0: iq = anadecrunch(p,q1.l,sbit,ch.bsize,ch.nblocks); break; case 1: iq = anadecrunch8(p,q1.l,sbit,ch.bsize,ch.nblocks); break; case 2: iq = anadecrunchrun(p,q1.l,sbit,ch.bsize,ch.nblocks); break; case 3: iq = anadecrunchrun8(p,q1.l,sbit,ch.bsize,ch.nblocks); break; case 4: iq = anadecrunch32(p,q1.l,sbit,ch.bsize,ch.nblocks); break; default: printf("error in data type for compressed data, fh->datyp =%d\n",type); iq = -1; break; } if (iq != 1) { fclose(fin); return -1; } } else { /* non-compression case, just read into the array */ /* the top bit of the byte fh->subf denotes endian type, 0 for little and 1 for big */ if (fread(q1.l, 1, nb, fin) != nb) { execute_error(91); fclose(fin); return -1; } #if defined(LITTLEENDIAN) if (type == 1 && (fh->subf >= 128 && wwflag == 0)) swapb((char *)q1.l, nb); if (type == 2 && (fh->subf >= 128 && wwflag == 0)) { /* printf("doing a swapl\n"); */ swapl(q1.l, nb/4); } /* 9/20/95, discovered that wwflag = 1 => no swap even for subf>=128 */ if (type == 3 && (fh->subf >= 128 && wwflag == 0)) swapl(q1.l, nb/4); if (type == 4 && (fh->subf >= 128 && wwflag == 0)) swapd(q1.l, nb/8); #else if (type == 1 && (fh->subf < 128 || wwflag == 1) ) swapb((char *)q1.l, nb); if (type == 2 && (fh->subf < 128 || wwflag == 1) ) swapl(q1.l, nb/4); if (type == 3 && (fh->subf < 128 || wwflag == 1)) { /*printf("warning, might be unsupported floating point data from VMS\n");*/ swapl(q1.l, nb/4); } if (type == 4 && (fh->subf < 128 || wwflag == 1)) { /*printf("warning, might be unsupported floating point data from VMS\n");*/ swapd(q1.l, nb/8); } #endif } /* common section again */ fclose(fin); return 1; } /*-------------------------------------------------------------------------*/ int ana_fzwrite(narg,ps) /* fzwrite subroutine */ /* write standard f0 files, uncompressed */ int narg, ps[]; { int iq, n, nc, nd, j, type, i, mq, nq, sbit, class, stat, fileclass=0; char *p, *q; struct ahead *h; struct fzhead *fh; union types_ptr q1; FILE *fopen(),*fout; /* a 4th argument added (optional) to specify a file class */ /* upgrade for string arrays, following LS suggestions */ /* first arg. must be an array or string array */ /* also modify to handle symarr's, these can be almost anything so we have to store the sym descriptors */ iq = ps[0]; class = sym[iq].class; if (class != ARRAY && class != STRING_PTR && class != SYM_ARR) return execute_error(66); type = sym[iq].type; h = (struct ahead *) sym[iq].spec.array.ptr; /* for symarr's, q1 will point to the array of pointers */ q1.l = (int *) ((char *)h + sizeof(struct ahead)); nd = h->ndim; /* second argument must be a string, file name */ if ( sym[ ps[1] ].class != 2 ) return execute_error(70); name = (char *) sym[ps[1] ].spec.array.ptr; /* try to open the file */ if ((fout=fopen(name,"w")) == NULL) return file_open_error(); //printf("open files (ana_fzwrite) = %d\n", getdtablehi()); /* use scrat to setup header */ fh = (struct fzhead *) scrat; bzero( (char *) fh, 512); /*zero it first */ /* these have to be readable by the Vax's */ #ifdef LITTLEENDIAN fh->synch_pattern = 0x5555aaaa; fh->subf = 0; fh->source = 0; #else /* big endian option */ fh->synch_pattern = 0xaaaa5555; fh->subf = 128; fh->source = 0; #endif fh->nhb = 1; /* may be changed later */ fh->datyp = type; fh->ndim = nd; /* type for sym arrays is MIXED_TYPES which is unique for these so type alone can (presently) ID a stored sym array */ /* 1/20/00 - make n just the element count rather than the byte count */ n = 1; /* set the dimensions */ for(j=0;jdims[j]; fh->dim[j] = h->dims[j]; } #ifdef LITTLEENDIAN #else /* big endian option */ swapl(&fh->dim[0],(int) fh->ndim); /* for BIGENDIAN machines (SGI) */ #endif /* check for text to put in header */ if (narg > 2 ) { /* has to be a string variable */ if ( sym[ ps[2] ].class != 2 ) { printf("header not a string\n"); return execute_error(70); } p = (char *) sym[ps[2] ].spec.array.ptr; mq = sym[ps[2] ].spec.array.bstore; q = (char *) fh->txt; if ( mq > 256 ) { j = (mq-256)/512 + 2; if (j > 15) { printf("header more than 16 blocks ! Cannot handle it!\n"); fclose(fout); return -1; } bzero( ((char *) scrat)+512, (j-1)*512); fh->nhb = j; } while (mq--) *q++ = *p++; } /* a 4th argument to allow setting a file class */ /* initial application for movie files */ if (narg > 3 ) { if (int_arg_stat(ps[3], &fileclass) != 1) return -1; } fh->file_class = fileclass; j=fwrite(fh, 1, 512 * fh->nhb, fout); /*write header */ if (j != 512 * fh->nhb) { execute_error(90); fclose(fout); return -1; } /* keep j as our position in file, used later for SYM_ARR's */ printf("n = %d\n",n); /* support arrays and string arrays */ /* 5/11/2000 - also symarr's */ switch (class) { case STRING_PTR: { char **q; q = (char **) ((char *) h + sizeof(struct ahead)); /* writes out n strings, each has its length (I*4) and the string */ while (n--) { /* equivalent to LS's code, note that the count is done in the native byte order */ if (*q) mq = strlen(*q); else mq = 0; fwrite(&mq, sizeof(int), 1, fout); if (mq) stat = (fwrite(*q++, 1, mq, fout) == mq); } stat = 1; } break; case ARRAY: n = n*ana_type_size[type]; stat = (fwrite(q1.l, 1, n, fout) == n); break; case SYM_ARR: /* done differently to allow easier random access, first we write all the symbol headers and then all the data blocks. The data pointers are from the start of the file (so we can just do seeks). The individual symbols can have their data compressed so a compression flag is also added. */ /* 11/26/2000 - to be portable between different machines, we can't directly use the sym_desc structures but need to decompose them into a known byte stream, ugh ... */ printf("sym arr section\n"); { struct sym_desc *pbase, *pdesc; int jout, nsize = 16, narr; pdesc = pbase = (struct sym_desc *) ((char *)h + sizeof(struct ahead)); printf("# of symbols in sym array = %d\n", n); /* j will be computed position in file of each data section, must add the computed size taken by the descriptors first */ narr = n; j += n * nsize; while (narr--) { /* mostly to be compatible with some files written out using SGI's before going to the portable form, we use 16 bytes per desc here even though only 12 are needed. The SGI pads (in the darn middle!) the sym_desc structure */ /* write this sym desc to the file, data comes later */ if (sym_desc_out(fout, pdesc, j)) { execute_error(90); fclose(fout); return -1; } pdesc++; /* for the next position, increase j by bstore */ j += pdesc->spec.array.bstore; } /* that wraps the descriptors which took a known amount of space that can be calculated from the file header (for readback), now the data itself */ narr = n; pdesc = pbase; while (narr--) { /* again we have to be portable and also consistent with the early SGI generated files. The ahead structure for the arrays is the main issue here. This will be done in big endian and with the SGI alignment. The data will be in native alignment to avoid lots of byte re-ordering. Be careful of course. */ class = pdesc->class; if (class == SYM_ARR) { printf("sorry, nested symbol arrays not supported for file output\n"); return -1; } p = (char *) pdesc->spec.array.ptr; nsize = pdesc->spec.array.bstore; if (class == ARRAY || class == STRING_PTR ) { /* the ahead data stored may not take the same space as the struct ahead for a given machine */ int extra = (int) (40 - sizeof(struct ahead)); struct ahead *h2; int nb, i, iq; byte zpad[8] = {8*0}, x[4]; nb = 1; h2 = (struct ahead *) p; /* write out the number of dimensions */ jout = fwrite(&h2->ndim, 1, nb, fout); nb = 3; /* 3 zeroes */ jout = fwrite(zpad, 1, nb, fout); /* the dimension values */ nb = 4; for (i=0;i<8;i++) { iq = h2->dims[i]; x[0] = (byte) (iq >> 24); x[1] = (byte) (iq >> 16); x[2] = (byte) (iq >> 8); x[3] = (byte) (iq); jout = fwrite(x, 1, nb, fout); } /* and some more zips */ nb = 4; jout = fwrite(zpad, 1, nb, fout); /* now setup to write out the rest, the in memory pointer needs to get bumped by the local size of struch ahead */ p = p + sizeof(struct ahead); nsize = nsize - sizeof(struct ahead); } jout = fwrite(p, 1, nsize, fout); if (jout != nsize) { execute_error(90); fclose(fout); return -1; } pdesc ++; } } break; } fclose(fout); if (stat) return 1; else return execute_error(90); } /*------------------------------------------------------------------------- */ int ana_fcrunwrite(narg,ps) /* fcrunwrite subroutine */ /* write standard f0 files, compressed format with additional run length encoding which helps when there are large blank areas*/ int narg, ps[]; { /* we just set the runlengthflag to 1 and call fcwrite */ int iq; runlengthflag = 1; iq = ana_fcwrite(narg,ps); runlengthflag = 0; /* re-set to default */ return iq; } /*------------------------------------------------------------------------- */ int ana_fcwrite(narg,ps) /* fcwrite subroutine */ /* write standard f0 files, compressed format */ int narg, ps[]; { int iq, n, nc, nd, j, type, i, mq, nq, sbit, nx, ny, limit; char *p, *q; struct ahead *h; struct fzhead *fh; union types_ptr q1, q2; union { int i; byte b[4];} lmap; FILE *fopen(),*fout; /* first arg. must be an array */ iq = ps[0]; if ( sym[iq].class != 4 ) return execute_error(66); type = sym[iq].type; if (type != 0 && type != 1 && type != 2) return execute_error(105); h = (struct ahead *) sym[iq].spec.array.ptr; q1.l = (int *) ((char *)h + sizeof(struct ahead)); nd = h->ndim; /* second argument must be a string, file name */ if ( sym[ ps[1] ].class != 2 ) return execute_error(70); name = (char *) sym[ps[1] ].spec.array.ptr; /* try to open the file */ if ((fout=fopen(name,"w")) == NULL) return file_open_error(); //printf("open files (ana_fcwrite) = %d\n", getdtablehi()); /* use scrat to setup header */ fh = (struct fzhead *) scrat; bzero( (char *) fh, 512); /*zero it first */ /* these have to be readable by the Vax's and Alpha's */ #ifdef LITTLEENDIAN fh->synch_pattern = 0x5555aaaa; fh->subf = 1; fh->source = 0; #else fh->synch_pattern = 0xaaaa5555; fh->subf = 129; fh->source = 0; #endif fh->nhb = 1; /*may be changed later */ fh->datyp = type; fh->ndim = nd; n = 1; for(j=0;jdims[j]; fh->dim[j] = h->dims[j]; } nx = fh->dim[0]; ny = n/nx; n = n * ana_type_size[type]; #ifdef LITTLEENDIAN #else swapl(&fh->dim[0],(int) fh->ndim); /* for BIGENDIAN machines (SGI) */ #endif /* check for text to put in header */ if (narg > 2 ) { /* has to be a string variable */ if ( sym[ ps[2] ].class != 2 ) { printf("header not a string\n"); return execute_error(70); } p = (char *) sym[ps[2] ].spec.array.ptr; mq = sym[ps[2] ].spec.array.bstore; q = (char *) fh->txt; if ( mq > 256 ) { j = (mq-256)/512 + 2; if (j > 15) { printf("header more than 16 blocks ! Cannot handle it!\n"); fclose(fout); return -1; } bzero( ((char *) scrat)+512, (j-1)*512); fh->nhb = j; } while (mq--) *q++ = *p++; } /* now compress the array, must be a byte or short */ /* extended to 32 bits 2/4/96 */ limit = n + n/2; q2.l = (int *) malloc(limit); /* some room for mistakes */ if (q2.l == NULL) return execute_error(123); switch (type) { case 0: if (runlengthflag == 0) iq = anacrunch8( q2.l, q1.l, crunch_slice, nx, ny, limit); else iq = anacrunchrun8( q2.l, q1.l, crunch_slice, nx, ny, limit); break; case 1: if (runlengthflag == 0) iq = anacrunch( q2.l, q1.l, crunch_slice, nx, ny, limit); else iq = anacrunchrun( q2.l, q1.l, crunch_slice, nx, ny, limit); break; case 2: if (runlengthflag == 0) iq = anacrunch32( q2.l, q1.l, crunch_slice, nx, ny, limit); else { printf("FCRUNWRITE not supported for I*4 yet\n"); return -1;} break; default: return execute_error(3); } if ( iq < 0 ) { printf("not enough space allocated (%d bytes) for compressed array\n",limit); free(q2.l); fclose(fout); return -1; } /* nice to know these values */ crunch_bpp = 8.0 * iq / (nx * ny); crunch_bits = 8 * iq; lmap.i = iq; #ifdef LITTLEENDIAN #else swapl(&lmap.i,1); #endif for (i=0;i<4;i++) fh->cbytes[i]=lmap.b[i]; j=fwrite(fh, 1, 512 * fh->nhb, fout); /*write header */ if (j != 512 * fh->nhb) { free(q2.l); execute_error(90); fclose(fout); return -1; } if (fwrite(q2.l, 1, iq, fout) != iq) { free(q2.l); execute_error(90); fclose(fout); return -1; } free(q2.l); fclose(fout); return 1; } /*------------------------------------------------------------------------- */ int ana_fzread_f(narg, ps) /* a function version that returns 1 if read OK */ int narg, ps[]; { if ( ana_fzread(narg, ps) == 1 ) return 1; else return 4; } /*------------------------------------------------------------------------- */ int ana_fzwrite_f(narg, ps) /* a function version that returns 1 if read OK */ int narg, ps[]; { if ( ana_fzwrite(narg, ps) == 1 ) return 1; else return 4; } /*------------------------------------------------------------------------- */ int ana_fcwrite_f(narg, ps) /* a function version that returns 1 if read OK */ int narg, ps[]; { if ( ana_fcwrite(narg, ps) == 1 ) return 1; else return 4; } /*------------------------------------------------------------------------- */ int ana_fcrunwrite_f(narg, ps) /* a function version that returns 1 if read OK */ int narg, ps[]; { if ( ana_fcrunwrite(narg, ps) == 1 ) return 1; else return 4; } /*------------------------------------------------------------------------- */ int ana_fzhead_f(narg, ps) /* a function version that returns 1 if read OK */ int narg, ps[]; { if ( ana_fzhead(narg, ps) == 1 ) return 1; else return 4; } /*------------------------------------------------------------------------- */ /* interface to the cfitsio libraries /*------------------------------------------------------------------------- */ int ana_cfitsio_read(narg, ps) /* read cfitsio fits files */ /* status = cfitsio_read(x, name) */ /* code taken from imcopy (mostly) in the cfitsio distribution, we use this mainly to handle compressed files, only handles single images */ int narg, ps[]; { int i, iq, status = 0, hdupos, type; int hdutype, bitpix, bytepix, naxis = 0, nkeys, datatype = 0, anynul; char *name; size_t naxes[9], first, totpix = 0; double *array, bscale = 1.0, bzero = 0.0, nulval = 0.; struct ahead *h; fitsfile *infptr; iq = ps[1]; if ( sym[iq].class != 2 ) { return execute_error(70);} name = (char *) sym[iq].spec.array.ptr; ffopen(&infptr, name, READONLY, &status); if (status) { fits_report_error(stderr, status); return 4; } fits_get_hdu_num(infptr, &hdupos); /* Get the current HDU position */ /* we could use code similar to that in imcopy to get all possible HDU's in the file, but just get the first image for this single array, so we skip an initial null image and complain about tables */ if (hdupos != 1) { printf("hdupos = %d, it should be 1, what is this? bailout\n", hdupos); } fits_get_hdu_type(infptr, &hdutype, &status); if (hdutype == IMAGE_HDU) printf("an image type\n"); else printf("hdutype = %d\n", hdutype); fits_get_img_dim(infptr, &naxis, &status); //printf("naxis = %d\n", naxis); /* is this an interesting file? */ if (naxis == 0 || (hdutype != IMAGE_HDU)) { /* no, skip and try next HDU */ fits_movrel_hdu(infptr, 1, &hdutype, &status); /* try to move to next HDU */ //printf("the second HDU\n"); if (hdutype == IMAGE_HDU) printf("an image type\n"); else printf("hdutype = %d\n", hdutype); fits_get_img_dim(infptr, &naxis, &status); //printf("naxis = %d\n", naxis); /* if this second one isn't an image, give up (for early version at least) */ if (naxis == 0 || (hdutype != IMAGE_HDU)) { printf("no image found in second HDU (or naxis = 0), giving up\n"); fits_close_file(infptr, &status); return 4; } } /* we should have an image if we get here, parts of imcopy.c used here */ /* get image dimensions and total number of pixels in image */ fits_get_img_param(infptr, 9, &bitpix, &naxis, naxes, &status); totpix = 1; for (i=0;i 1 BITPIX keys, using first one\n"); break; case 2: printf("illegal BITPIX key\n"); break; case 3: printf("found > 1 NAXIS keys, using first one\n"); break; case 4: printf("could not decode BITPIX value\n"); break; case 5: printf("could not decode NAXIS value\n"); break; case 6: printf("header block limit of %d exceeded\n", HEAD_LIMIT); break; case 7: printf("could not malloc for extended header\n"); break; case 8: printf("could not decode NAXISn key\n"); break; case 9: printf("could not create header\n"); break; case 10: printf("could not create data array\n"); break; case 11: printf("error reading fits header\n"); break; case 12: printf("error reading fits data array\n"); break; case 13: printf("error positioning to extension header\n"); break; case 14: printf("extension header block limit of %d exceeded\n", HEAD_LIMIT); break; case 15: printf("could not malloc for large extension header\n"); break; case 16: printf("error reading fits extension header\n"); break; case 17: printf("XTENSION keyword not found\n"); break; case 18: printf("could not create extension header\n"); break; case 19: printf("could not create extenesion data array\n"); break; case 20: printf("error reading fits extension data array\n"); break; case 21: printf("could not decode TFIELDS value\n"); break; case 22: printf("could not decode GCOUNT value\n"); break; case 23: printf("could not decode TFORM key value in extension\n"); break; case 24: printf("could not decode TTYPE key value in extension\n"); break; case 25: printf("extension column number > tfields\n"); break; default: printf("undocumented FITS error\n"); break; } return 1; } /*------------------------------------------------------------------------- */ char *bigger_header(n, head) int n; char *head; { /* we want 2880*n bytes */ int nb; char *p; nb = n*2880; if (nb <= (NSCRAT * sizeof(int)) ) p = (char *) scrat; else { /* need to malloc a larger space and copy over */ p = (char *) malloc(nb); if (p == NULL ) return p; /* 11/30/2009 - the copy length was wrong */ //bcopy(head, p, nb); bcopy(head, p, (n-1)*2880); /* if previous was a malloc, free it now */ if (fits_head_malloc_flag) free(head); fits_head_malloc_flag = 1; } return p; } /*------------------------------------------------------------------------- */ int fits_fatality(fin) FILE *fin; { printf("FITS problem was fatal, sorry\n"); if (fits_head_malloc_flag) free(fitshead); fclose(fin); return 4; /* this is the zero symbol */ } /*------------------------------------------------------------------------- */ int ana_fits_read(narg, ps) /* read fits files */ /* status = fits_read(x, name, [h], [x2], [h2], [extvar_preamble]) */ int narg, ps[]; { int hsym = 0, mode, xhsym=0, xdsym =0; /* uses fits_read, mode depends on arguments */ /* mode mask uses bits to specify products to return 1 bit: main header, 2 bit: main array, 4 bit: offset value 8 bit: ext offset value, 16 bit: ext header, 32 bit: ext array 64 bit: generate extension variables */ mode = 2; if (narg >= 3) { mode = 3; hsym = ps[2]; } if (narg >= 4) { mode = mode + 32; xdsym = ps[3]; } if (narg >= 5) { mode = mode + 16; xhsym = ps[3]; } if (narg >=6) { mode = mode + 64; if ( sym[ ps[5] ].class != 2 ) return execute_error(70); preamble = (char *) sym[ps[5] ].spec.array.ptr; } return fits_read(mode, ps[0], ps[1], hsym,0,0,xhsym, xdsym); } /*------------------------------------------------------------------------- */ int ana_fits_header(narg, ps) /* read fits header */ /* status = fits_header(name, [h], [h2], [extvar_preamble]) */ int narg, ps[]; { int hsym = 0, mode, xhsym = 0; /* uses fits_read, mode depends on arguments */ /* mode mask described in ana_fits_read */ mode = 0; if (narg >= 2) { mode = 1; hsym = ps[1]; } if (narg >=3) { mode = mode + 16; xhsym = ps[2]; } if (narg >=4) { mode = mode + 64; if ( sym[ ps[3] ].class != 2 ) return execute_error(70); preamble = (char *) sym[ps[3] ].spec.array.ptr; } return fits_read(mode, 0, ps[0], hsym, 0, 0, xhsym, 0); } /*------------------------------------------------------------------------- */ int ana_fits_xread(narg, ps) /* read fits extension and headers /* status = fits_xread(x2, name, [h], [h2], [offset], [extvar_preamble]) */ int narg, ps[]; { int hsym = 0, mode, xhsym = 0, offsetsym = 0, extvar_preamble; /* uses fits_read, mode depends on arguments */ /* mode mask described in ana_fits_read */ mode = 32; if (narg >= 3) { mode = mode + 1; hsym = ps[2]; } if (narg >=4) { mode = mode + 16; xhsym = ps[3]; } if (narg >=5) { mode = mode + 4; offsetsym = ps[4]; } if (narg >=6) { mode = mode + 64; if ( sym[ ps[5] ].class != 2 ) return execute_error(70); preamble = (char *) sym[ps[5] ].spec.array.ptr; } return fits_read(mode, 0, ps[1], hsym, offsetsym, 0, xhsym, ps[0]); } /*------------------------------------------------------------------------- */ int fits_read(mode, dsym, namsym, hsym, offsetsym, xoffsetsym, xhsym, xdsym) /* internal, read fits files */ /* returns status as sym # for 0, 1, or 2 */ int mode, dsym, namsym, hsym, xoffsetsym, xhsym, xdsym, offsetsym; { static char tforms[] = "IJAEDB"; static int tform_sizes[] = { 2, 4, 1, 4, 8, 1}; FILE *fin, *fopenr; char *fitshead, line[80], *lptr, c, **p, *q, *ext_ptr, *sq, *p2, *qb; int n, simple_flag, bitpix_flag = 0, naxis_flag = 0, naxis_count; int bitpix, type, nlines, end_flag = 0, nhblks, lc, iq, id, new_sym; int maxdim, i, rsym = 1, nbsize, ext_flag=0, data_offset, npreamble; int fits_type, ndim_var, *dim_var, n_ext_rows, nrow_bytes, m, nb; int xtension_found = 0, xdata_offset, tfields, gcount, row_bytes, row_count; int ext_stuff_malloc_flag = 0; struct ahead *h; struct ext_params { int repeat; int type; double scale, zero; char *lab; }; struct ext_params *ext_stuff; /* first arg is the variable to load, second is name of file */ if ((fin=fopenr_sym(namsym)) == NULL) return 4; /* use scrat to read in header block of 2880 bytes, we implicitly assume scrat is large enough for at least one, beyond that we check */ fitshead = (char *) scrat; fits_head_malloc_flag = 0; if (fread(fitshead, 1, 2880, fin) != 2880) { perror("fits_read in header"); return fits_fatality(fin); } /* a fits header is a series of card images, 80 columns by 36 cards */ /* must have "SIMPLE" at start */ // first line is done separately, we look for SIMPLE n = sscanf(fitshead, "SIMPLE = %1s", &c); if (n != 1) { printf("not a FITS file\n"); return fits_fatality(fin); } if (c == 'T') simple_flag = 1; else simple_flag = 0; if (!simple_flag) { /* check if one of my special fitz files */ q = (char *) malloc(81); bcopy(fitshead, q, 80); *(q+80) = 0; if (strstr(q, "ana rice compressed")) simple_flag = 2; else printf("warning, not a simple FITS file\n"); free(q); } nlines = 35; // lines left in this block lptr = fitshead; nhblks = 1; lc = 1; bzero( dim, 8*sizeof(int)); maxdim = 0; while (1) { /* outer loop to handle multiple header blocks */ while (nlines--) { /* 36 for a full header block, 35 for first */ lptr += 80; /* bump here so we can use continue's in each check */ lc++; //printf("%.80s\n", lptr); /* look for keywords on each line, decode ones we need */ if (strncmp(lptr, "BITPIX ",8) == 0) { /* got a BITPIX, get value */ if (bitpix_flag) { /* whoops, already have this */ fits_problems(1); } else { n = sscanf(lptr+9,"%d", &bitpix); if (n >= 1) { bitpix_flag = 1; //printf("found bitpix = %d\n", bitpix); /* translate to ana type */ switch (bitpix) { case 8: type = 0; break; case 16: type = 1; break; case 32: type = 2; break; case -32: type = 3; break; case -64: type = 4; break; default: fits_problems(2); printf("%d\n", bitpix); return fits_fatality(fin); } } else { /* couldn't decode the bitpix, sorry */ fits_problems(4); return fits_fatality(fin); } } /* don't try to match other keys since this one matched */ } else if (strncmp(lptr, "NAXIS ",8) == 0) { /* got a NAXIS, get value */ if (naxis_flag) { /* whoops, already have this */ fits_problems(3); } else { n = sscanf(lptr+9,"%d", &naxis_count); if (n >= 1) { naxis_flag = 1; } else { /* couldn't decode the naxis, sorry */ fits_problems(5); return fits_fatality(fin); } /* check if dimension too high */ if (naxis_count > 8 || naxis_count < 0) { printf("dimension count %d (NAXIS) out of range\n", naxis_count); return fits_fatality(fin); } } } else if (strncmp(lptr, "NAXIS",5) == 0) { /* got a NAXISn, get value and dimension */ n = sscanf(lptr+5,"%d = %d", &iq, &id); if (n != 2) /* couldn't decode the naxis, sorry */ { /* some idl fits file generators put in extra, bogus NAXISn lines, so just try to ignore and see what happens */ //fits_problems(8); return fits_fatality(fin); printf("bad NAXIS key ignored, was: %.80s\n", lptr); } else { //printf("dimension = %d, value = %d\n", iq, id); if (iq < 1 || iq > 8) { fits_problems(9); return fits_fatality(fin); } dim[iq-1] = id; maxdim = MAX(maxdim, iq); /* check if dimension too high */ if (maxdim > 8 || maxdim < 1) { printf("dimension count %d (NAXIS) out of range\n", maxdim); return fits_fatality(fin); } } } else if (strncmp(lptr, "EXTEND ",8) == 0) { /* got an extension flag */ ext_flag = 1; } else if (strncmp(lptr, "END ",8) == 0) { end_flag = 1; //printf("total lines in header = %d\n", lc); break; /* this ends the header read */ } } if (end_flag) break; else { /* haven't hit an END yet, so we read another header block */ if (nhblks > HEAD_LIMIT) { fits_problems(6); return fits_fatality(fin);} fitshead = bigger_header(nhblks+1, fitshead); if (fitshead == NULL) { fits_problems(7); return fits_fatality(fin);} if (fread(fitshead+nhblks*2880, 1, 2880, fin) != 2880) { perror("fits_read in header"); fits_problems(11); return fits_fatality(fin);} nlines = 36; nhblks++; } } /* check out */ //printf("nhblks = %d, maxdim = %d\n", nhblks, maxdim); /* the data offset will be useful for TRACE hourlies */ data_offset = nhblks * 2880; //for (i=0;i HEAD_LIMIT) { fits_problems(14); return fits_fatality(fin);} fitshead = bigger_header(nhblks, fitshead); if (fitshead == NULL) { fits_problems(15); return fits_fatality(fin);} if (nread = fread(fitshead+(nhblks-1)*2880, 1, 2880, fin) != 2880) { /* be quiet about this unless an extension product was asked for */ /* 2/6/2008 - actually, be quiet even if it was requested because this happens often */ // if (mode & 0x7c) { perror("fits_read in extension header"); fits_problems(16); } ext_flag = 0; break; } nlines = 36; lptr = fitshead+(nhblks-1)*2880; while (nlines--) { lc++; //printf("%.80s\n", lptr); /* look for keywords on each line, decode ones we need */ if (strncmp(lptr, "XTENSION",8) == 0) { xtension_found = 1; } else if (strncmp(lptr, "BITPIX ",8) == 0) { /* got a BITPIX, get value */ if (bitpix_flag) { /* whoops, already have this */ fits_problems(1); } else { n = sscanf(lptr+9,"%d", &bitpix); if (n >= 1) { bitpix_flag = 1; //printf("found bitpix = %d\n", bitpix); /* translate to ana type */ switch (bitpix) { case 8: type = 0; break; case 16: type = 1; break; case 32: type = 2; break; case -32: type = 3; break; case -64: type = 4; break; default: fits_problems(2); printf("%d\n", bitpix); ext_flag = 0; break; } } else { /* couldn't decode the bitpix, sorry */ fits_problems(4); ext_flag = 0; break; } } } else if (strncmp(lptr, "NAXIS ",8) == 0) { /* got a NAXIS, get value */ if (naxis_flag) { /* whoops, already have this */ fits_problems(3); } else { n = sscanf(lptr+9,"%d", &naxis_count); if (n >= 1) { naxis_flag = 1; } else { /* couldn't decode the naxis, sorry */ fits_problems(5); ext_flag = 0; break; } /* check if dimension too high */ if (naxis_count > 8 || naxis_count < 1) { printf("dimension count %d (NAXIS) out of range\n", naxis_count); ext_flag = 0; break; } } } else if (strncmp(lptr, "NAXIS",5) == 0) { /* got a NAXISn, get value and dimension */ n = sscanf(lptr+5,"%d = %d", &iq, &id); if (n != 2) /* couldn't decode the naxis, sorry */ { fits_problems(8); return fits_fatality(fin); } //printf("dimension = %d, value = %d\n", iq, id); if (iq < 1 || iq > 8) { fits_problems(9); ext_flag = 0; break; } dim[iq-1] = id; maxdim = MAX(maxdim, iq); /* check if dimension too high */ if (maxdim > 8 || maxdim < 1) { printf("dimension count %d (NAXIS) out of range\n", maxdim); ext_flag = 0; break; } } else if (strncmp(lptr, "TFIELDS ",8) == 0) { n = sscanf(lptr+9,"%d", &tfields); if (n !=1) { fits_problems(21); } } else if (strncmp(lptr, "GCOUNT ",8) == 0) { n = sscanf(lptr+9,"%d", &gcount); if (n !=1) { fits_problems(22); } } else if (strncmp(lptr, "END ",8) == 0) { end_flag = 1; //printf("total lines in header = %d\n", lc); break; /* this ends the header read */ } lptr += 80; } if (!xtension_found || ext_flag == 0) { /* be quiet about this unless an extension product was asked for */ /* not useful in general (?) so just keep quiet */ printf("mode = %#x\n", mode); if (mode & 0x7c) { fits_problems(17); } ext_flag = 0; break; } if (end_flag) break; } if (ext_flag) { /* in case we had an error along the way */ /* check out */ //printf("nhblks = %d, maxdim = %d\n", nhblks, maxdim); xdata_offset = ext_flag + nhblks * 2880; //for (i=0;i tfields || iq < 1) { fits_problems(25); } else { index = iq - 1; ext_stuff[index].repeat = id; loc = strchr(tforms, (int) line[0]); if (loc == NULL) { printf("unsupported extension column format %s\n", line); itype = -1;} else itype = loc - tforms; ext_stuff[index].type = itype; } } else /* look for the label */ if (strncmp(lptr, "TTYPE",5) == 0) { /* got a TTYPE, get "column" */ n = sscanf(lptr+5,"%d = '%s", &iq, line); if (n != 2) /* couldn't decode the type, sorry */ { fits_problems(24); return fits_fatality(fin); } /* check if within range */ if (iq > tfields || iq < 1) { fits_problems(25); } else { index = iq - 1; q = line; /* need to remove any "attached" single quotes on the end of the symbol */ while (*q) { if (*q == '\'') {*q = 0; break; } q++; } //printf("TTYPE column = %d, label %s\n", iq, line); ext_stuff[index].lab = strdup(line); } } lptr += 80; } /* for binary tables, the first dim is the # of bytes in each "row" */ row_bytes = 0; /* examine what we got */ //printf("ext_stuff listing\n"); for (index=0;index<=tfields-1;index++) { row_bytes += tform_sizes[ext_stuff[index].type]*ext_stuff[index].repeat; //printf("%d %d %s %f %f \t\t%d\n", //ext_stuff[index].repeat, //ext_stuff[index].type, //ext_stuff[index].lab, //ext_stuff[index].scale, //ext_stuff[index].zero, row_bytes); } if (row_bytes > dim[0]) { printf("mismatch: accumulated row width = %d, first dim = %d\n", row_bytes,dim[0]); return fits_fatality(fin); } /* set nrow_bytes to dim[0] which we destroy below */ nrow_bytes = dim[0]; /* make the ana variables, the last dim will be the number of rows. If the repeat in the tform is 1, then the array or strarr will be 1-D, otherwise it will be 2-D with repeat as the first dim */ /* want to use dim for the constructed arrays, so save the binary table row count elsewhere */ /* if we wanted the extension in a variable, we already read it in, otherwise we read it now */ if (!(mode & 0x20)) { q = ext_ptr = (char *) malloc(nbsize); ext_ptr_malloc_flag = 1; /* should be in position in file to just read in */ if (fread(q, 1, nbsize, fin) != nbsize) { perror("fits_read in data array"); free(ext_ptr); fits_problems(20); return fits_fatality(fin);} } /* one way or another, the entire table is now at ext_ptr */ npreamble = strlen(preamble); row_bytes = 0; lptr = ext_ptr; for (index=0;index<=tfields-1;index++) { int sl; char *ppq; /* construct the variable name */ sl = npreamble + strlen(ext_stuff[index].lab); sq = (char *) malloc(sl + 1); strcpy(sq, preamble); strcat(sq, ext_stuff[index].lab); /* note - *ppq++ = toupper(*ppq) doesn't work with som e compliers */ ppq = sq; while (sl--) { *ppq = toupper(*ppq); ppq++; } new_sym = find_sym(sq); //printf("variable name = %s, symbol # %d\n", sq, new_sym); free(sq); /* how we define depends on type */ id = ext_stuff[index].repeat; /* dimension count depends on "repeat" */ fits_type = ext_stuff[index].type; if (id <= 1 || fits_type == 2) { ndim_var = maxdim-1; dim_var = dim+1; } else { ndim_var = maxdim; dim_var = dim; /* but we have to load the repeat count as the first dimension, note that this destroys the original contents which we should no longer need */ dim[0] = id; } switch (fits_type) { case 0: /* I*2 array */ type = 1; break; case 1: /* I*4 array */ type = 2; break; case 3: /* F*4 array */ type = 3; break; case 4: /* F*8 array */ type = 4; break; case 5: /* I*1 array */ type = 0; break; } if (fits_type == 2) { char **psa; if (redef_strarr(new_sym, ndim_var, dim_var) != 1) fits_fatality(fin); h = (struct ahead *) sym[new_sym].spec.array.ptr; psa = (char **) ((char *)h + sizeof(struct ahead)); nbsize = tform_sizes[fits_type] * id; /* need to get a series of strings */ p2 = lptr; m = n_ext_rows; while (m--) { n = nbsize; q = malloc(nbsize + 1); *psa++ = q; while (n--) *q++ = *p2++; *q = 0; p2 = p2 + nrow_bytes - nbsize; } } else { if (redef_array(new_sym, type, ndim_var, dim_var) != 1) fits_fatality(fin); /* and load all the columns in */ h = (struct ahead *) sym[new_sym].spec.array.ptr; q = qb = (char *) ((char *)h + sizeof(struct ahead)); nbsize = tform_sizes[fits_type] * id; p2 = lptr; m = n_ext_rows; while (m--) { n = nbsize; while (n--) *q++ = *p2++; p2 = p2 + nrow_bytes - nbsize; } #ifdef LITTLEENDIAN nb = nbsize * n_ext_rows; if (fits_type == 0) swapb(qb, nb); if (fits_type == 1 || fits_type ==3) swapl(qb, nb/4); if (fits_type == 4) swapd(qb, nb/8); #endif } row_bytes += nbsize; lptr += nbsize; } if (ext_ptr_malloc_flag) free(ext_ptr); } /* should be done with any malloc for a long header */ if (fits_head_malloc_flag) free(fitshead); if (ext_stuff_malloc_flag) free(ext_stuff); fclose(fin); return rsym; /* this is the one symbol */ } /*------------------------------------------------------------------------- */ int ana_tiffwrite_f(narg, ps) /* a function version that returns 1 if read OK */ int narg, ps[]; { if ( ana_tiffwrite(narg, ps) == 1 ) return 1; else return 4; } /*------------------------------------------------------------------------- */ int ana_tiffwrite(narg,ps) /* tiffwrite subroutine */ /* write a very plain tiff file, 8 or 16 bits deep */ /* upgraded to handle 16 bit if array is I*2 */ /* 4/11/2000 - also handle rgb triplets (3,nx,ny) and colormaps (the latter used to be done by ana_tiffcolorwrite */ /* call is tiffwrite,array,file,[colormap],[ppi] where ppi is the pixels per inch which is used by word processing software for the size of the image on paper (or screen), the default ppi is 100 */ /* 9/27/92, start with 2-D byte files, minimum tag requirements */ int narg, ps[]; { TIFFDirEntry gray_tags[] = { TIFFTAG_IMAGEWIDTH, 4, 1, 0, TIFFTAG_IMAGELENGTH, 4, 1, 0, #if defined(LITTLEENDIAN) TIFFTAG_BITSPERSAMPLE, 3, 1, 8, TIFFTAG_COMPRESSION, 3, 1, 1, TIFFTAG_PHOTOMETRIC, 3, 1, PHOTOMETRIC_MINISBLACK, TIFFTAG_STRIPOFFSETS, 4, 1, 0, TIFFTAG_SAMPLESPERPIXEL, 3, 1, 1, TIFFTAG_ROWSPERSTRIP, 4, 1, 0, TIFFTAG_STRIPBYTECOUNTS, 4, 1, 0, TIFFTAG_XRESOLUTION, 5, 1, 0, TIFFTAG_YRESOLUTION, 5, 1, 0, TIFFTAG_RESOLUTIONUNIT, 3, 1, 2, #else TIFFTAG_BITSPERSAMPLE, 3, 1, 8*256*256, TIFFTAG_COMPRESSION, 3, 1, 1*256*256, TIFFTAG_PHOTOMETRIC, 3, 1, PHOTOMETRIC_MINISBLACK*256*256, TIFFTAG_STRIPOFFSETS, 4, 1, 0, TIFFTAG_SAMPLESPERPIXEL, 3, 1, 1*256*256, TIFFTAG_ROWSPERSTRIP, 4, 1, 0, TIFFTAG_STRIPBYTECOUNTS, 4, 1, 0, TIFFTAG_XRESOLUTION, 5, 1, 0, TIFFTAG_YRESOLUTION, 5, 1, 0, TIFFTAG_RESOLUTIONUNIT, 3, 1, 2*256*256, #endif TIFFTAG_COLORMAP, 3, 256*3, 0 /* used only for Palette-color images */ }; struct res { int num; int denom; } resolution_rational[2] = {100,1,100,1}; #define NTAGS (sizeof(gray_tags) / sizeof(TIFFDirEntry)) int iq, n, nc, nd, j, type, i, mq, nq, sbit, bigendian, xq; int nx, ny, ifd_next, color_malloc=0, colormap_flag = 0, ncolmap; short *psh, ifd_count, *pshort, *colormap = NULL; unsigned char *p; struct ahead *h, *h2; TIFFHeader *fh; TIFFDirEntry *tag; union types_ptr q1, q2; FILE *fopen(),*fout; /* first arg. must be an array */ iq = ps[0]; if ( sym[iq].class != 4 ) return execute_error(66); type = sym[iq].type; h = (struct ahead *) sym[iq].spec.array.ptr; q1.l = (int *) ((char *)h + sizeof(struct ahead)); nd = h->ndim; if (nd == 3) { /* could be a rgb triplet image */ if (h->dims[0] != 3 || type != 0) { printf("TIFFWRITE - unsupported 3-D file\n"); return -1; } nx = h->dims[1]; ny = h->dims[2]; n = 3 *nx * ny; /* also set some tags for full color images later using nd as a flag */ } else { if ( nd != 2 || type > 1 ) { printf("TIFFWRITE only supports 2-D byte and I*2 arrays\n"); return -1; } nx = h->dims[0]; ny = h->dims[1]; n = nx * ny; if (type == 1) n *= 2; } /* second argument must be a string, file name */ if ( sym[ ps[1] ].class != 2 ) return execute_error(70); name = (char *) sym[ps[1] ].spec.array.ptr; colormap_flag = 0; /* optional 3rd and 4th arguments */ if (narg > 2) { /* if an array, assume it is a colormap, otherwise ppi */ iq = ps[2]; if ( sym[iq].class == 4 ) { /* color map, handle I*1 or I*2 gracefully */ h2 = (struct ahead *) sym[iq].spec.array.ptr; q2.l = (int *) ((char *)h2 + sizeof(struct ahead)); /* we are fussy about the organization of the color map, must be 256x3 */ if (h2->ndim != 2 || h2->dims[0] != 256 || h2->dims[1] != 3 || sym[iq].type > 1) { printf("TIFFWRITE requires a 256 by 3 color map, either I*1 or I*2\n"); return -1; } /* also can't have a color map for full color (rgb) images) */ if (nd == 3) { printf("TIFFWRITE: can't specify map for full color image\n"); return -1; } /* also catch I*2 plus colormap, this is illegal too */ if (type != 0) { printf("TIFFWRITE: can't specify map for I*2 image\n"); return -1; } ncolmap = 256*3*2; /* length in bytes of final colormap */ switch (sym[iq].type) { case 0: /* we got a I*1 colormap, convert to I*2 */ if ( (colormap = malloc(ncolmap)) == NULL) return execute_error(123); color_malloc = 1; nq = 256*3; pshort = colormap; p = q2.b; while (nq--) *pshort++ = ((short) (*p++)) << 8; break; case 1: colormap = q2.w; break; } colormap_flag = 1; } else { if (int_arg_stat(iq, &xq) != 1) return -1; resolution_rational[0].num = xq; resolution_rational[1].num = xq; } } if (narg > 3) { /* a fourth argument has to be pixels per inch */ if (int_arg_stat(ps[3], &xq) != 1) return -1; resolution_rational[0].num = xq; resolution_rational[1].num = xq; } /* try to open the file */ if ((fout=fopen(name,"w")) == NULL) return file_open_error(); //printf("open files (ana_tiffwrite) = %d\n", getdtablehi()); /* an endian detector, taken from SL's tiff library */ { int one = 1; bigendian = (*(char *)&one == 0); } fh = (TIFFHeader *) scrat; fh->tiff_magic = bigendian ? TIFF_BIGENDIAN : TIFF_LITTLEENDIAN; fh->tiff_version = TIFF_VERSION; fh->tiff_diroff = 8; /* stream out this (small) beginning */ if (fwrite(fh,1,sizeof(TIFFHeader),fout) != sizeof(TIFFHeader) ) { execute_error(90); fclose(fout); return -1; } /* write out the IFD count (just 2 bytes) */ ifd_count = NTAGS; if (!colormap_flag) ifd_count -= 1; if (fwrite(&ifd_count,1,sizeof(short),fout) != sizeof(short) ) { execute_error(90); fclose(fout); return -1; } /* create the tags needed */ gray_tags[0].tdir_offset = nx; gray_tags[1].tdir_offset = ny; gray_tags[7].tdir_offset = ny; gray_tags[8].tdir_offset = n; /* byte count */ /* set number of bits/sample */ if (type == 1) iq = 16; else iq = 8; if (fh->tiff_magic == TIFF_BIGENDIAN) iq = iq<<16; gray_tags[2].tdir_offset = iq; /* set samples per pixel if true color */ if (nd == 3) iq = 3; else iq = 1; if (fh->tiff_magic == TIFF_BIGENDIAN) iq = iq<<16; gray_tags[6].tdir_offset = iq; /* set photometric */ iq = 1; if (nd == 3) iq = 2; if (colormap_flag) iq = 3; if (fh->tiff_magic == TIFF_BIGENDIAN) iq = iq<<16; gray_tags[4].tdir_offset = iq; /* figure out where the resolution rationals (very annoying) are going to be */ nq = sizeof(gray_tags); /* if no colormap, drop the last tag */ if (!colormap_flag) nq = nq - sizeof(TIFFDirEntry); nc = sizeof(TIFFHeader)+nq+sizeof(ifd_count)+sizeof(ifd_next); gray_tags[9].tdir_offset = nc; nc = nc + sizeof(struct res); gray_tags[10].tdir_offset = nc; nc = nc + sizeof(struct res); gray_tags[12].tdir_offset = nc; if (colormap_flag) nc = nc + ncolmap; /* size of color table */ gray_tags[5].tdir_offset = nc; /* write out the tags in the IFD */ if (fwrite(gray_tags,1,nq,fout) != nq ) { execute_error(90); fclose(fout); return -1; } /* write out the offset to next IFD (none here) */ ifd_next = 0; if (fwrite(&ifd_next,1,sizeof(int),fout) != sizeof(int) ) { execute_error(90); fclose(fout); return -1; } /* write out the resolution rationals */ nc = sizeof(resolution_rational); if (fwrite( (void *) resolution_rational,1,nc,fout) != nc ) { execute_error(90); fclose(fout); return -1; } /* write out colormap if present */ if (colormap_flag) { if (fwrite( (void *) colormap, 1, ncolmap, fout) != ncolmap) { execute_error(90); fclose(fout); return -1; } } /* write out the data as one lump (one strip for TIFF), probably should re-write to do the recommended 64K strips */ if (fwrite( (void *) q1.l, 1, n, fout) != n) { execute_error(90); fclose(fout); return -1; } if (color_malloc) free(colormap); fclose(fout); return 1; } /*------------------------------------------------------------------------- */ int file_error(code, file) int code; FILE *file; { /* a minor elaboration on a return error, this also closes the file */ fclose(file); if (code >= 0) execute_error(code); return -1; } /*------------------------------------------------------------------------- */ int ana_tiffread_f(narg, ps) /* a function version that returns 1 if read OK */ int narg, ps[]; { if ( ana_tiffread(narg, ps) == 1 ) return 1; else return 4; } /*------------------------------------------------------------------------- */ int ana_tiffread(narg,ps) /* tiffread subroutine */ /* read a few TIFF types, not comprehensive, single image */ /* currently reads 8 or 16 bit gray images */ int narg, ps[]; { int swab_flag, magic, offset, count, remote_flag, ndim; int iq, nc, nd, j, type, i, mq, nq, sbit, bigendian; int nx, ny, ifd_next, xq, return_stat=1, count_bitspersample; int nbits, nb,rowsperstrip,sampleperpixel,nstrips; int nstripbytecounts, planarconfig=1, orient=1, ncolors=0; int color_malloc=0; short *psh, ifd_count, dircount, compress_flag = 1; short tiff_tag, tiff_type, *pshort, *colormap = NULL; char *p; unsigned int tiff_count, tiff_offset; struct ahead *h; TIFFHeader fh; TIFFDirEntry *tags = NULL; int *strips = NULL, *stripbytecounts = NULL, *pint; int *strip_malloc = NULL, *stripbytes_malloc = NULL; union types_ptr q1; FILE *fopen(),*fin; /* first arg is the variable to load, second is name of file */ if ((fin=fopenr_sym(ps[1])) == NULL) return -1; /* read the tiff header and verify a tiff file */ if (fread(&fh,1,sizeof(TIFFHeader),fin) != sizeof(TIFFHeader) ) return file_error(134, fin); /* establish our endian situation */ /* an endian detector, taken from SL's tiff library */ { int one = 1; bigendian = (*(char *)&one == 0); } magic = fh.tiff_magic; swab_flag = 0; //printf("fh.tiff_magic = %d\n", fh.tiff_magic); switch (magic) { case TIFF_BIGENDIAN: if (!bigendian) swab_flag = 1; break; case TIFF_LITTLEENDIAN: if (bigendian) swab_flag = 1; break; default: printf("Not a TIFF file, bad magic number %d (0x%x)", magic,magic); return -1; } if (swab_flag) { swapb(&fh.tiff_version, 2); swapl(&fh.tiff_diroff, 1); } if (fh.tiff_version != TIFF_VERSION) { printf("Not a TIFF file, bad version number %d (0x%x)", fh.tiff_version,fh.tiff_version); return -1; } /* now the first IFD */ offset = fh.tiff_diroff; //printf("offset = %d\n", offset); if (fseek(fin, offset, SEEK_SET) ) { printf("TIFFREAD problem positioning to IFD at %#x\n", offset); return file_error(134, fin); } /* read the short (I*2) count */ if (fread(&dircount,1,sizeof(short),fin) != sizeof(short) ) return file_error(134, fin); if (swab_flag) swapb(&dircount, 2); //printf("tag count = %d\n", dircount); mq = dircount*sizeof(TIFFDirEntry); tags = malloc(mq); if (tags == NULL) return file_error(123, fin); /* read this batch */ if (fread(tags,1,mq,fin) != mq ) return file_error(134, fin); /* now breeze through the tags */ for (i=0;i 12) { printf("illegal tiff type %d\n", tiff_type); return file_error(-1, fin); } nb = tiff_type_size[tiff_type]; mq = tiff_count * nb; if (mq <= 4) { /* in tiff_offset, decode value into an int (I*4 here) */ remote_flag = 0; /* already did a swaplong on this if the endians didn't match, turns out we now just have to apply a shift if the item is not an int (I*4) and if the file was big endian, all other cases already OK for a count of 1*/ if (magic == TIFF_BIGENDIAN) xq = tiff_offset>>bigTypeshift[tiff_type]; else xq = tiff_offset; } else { /* elsewhere, we grab it, hoping we don't regret the action, must fit in scrat though or we just reject */ remote_flag = 1; /* fetch the stuff in scrat */ if (mq > NSCRAT * sizeof(int) ) { printf("TIFF directory entry too large for scrat: %d\n", mq); goto a_bad_end; } if (fseek(fin, tiff_offset, SEEK_SET) ) goto a_bad_end; if (fread(scrat,1,mq,fin) != mq ) goto a_bad_end; /* do any swapping needed, depends on bytes in the type */ if (swab_flag) { switch (nb) { case 2: swapb(scrat, tiff_count*2); break; case 4: swapl(scrat, tiff_count); break; case 8: swapd(scrat, tiff_count); break; default: break; } } } switch (tiff_tag) { case TIFFTAG_COMPRESSION: /* we don't do compression yet though not very hard if we used libtiff */ compress_flag = xq; if (xq != 1) { printf("sorry - can't read compressed TIFF files yet\n"); goto a_bad_end; } break; case TIFFTAG_BITSPERSAMPLE: /* we expect 1 or 3 here, don't know how to handle anything else */ count_bitspersample = tiff_count; if (remote_flag) { short *sbits = (short *) scrat; if (tiff_count != 3) goto a_bad_end; /* we want the 3 to be the same */ nbits = sbits[0]; if (nbits != sbits[1] || nbits != sbits[2]) { printf("unmatched bits per sample = %d %d %d\n", sbits[0], sbits[1], sbits[2]); goto a_bad_end; } } else nbits = xq; //printf("nbits = %d\n", nbits); break; case TIFFTAG_IMAGEWIDTH: if (tiff_count != 1) goto a_bad_end; nx = xq; break; case TIFFTAG_IMAGELENGTH: if (tiff_count != 1) goto a_bad_end; ny = xq; break; case TIFFTAG_PHOTOMETRIC: /* we want black as min if grayscale */ photometric = xq; if (xq < 1 || xq > 3) { printf("unsupported photometric = %d\n",photometric); goto a_bad_end; } break; case TIFFTAG_STRIPOFFSETS: nstrips = tiff_count; printf("# of strip offsets = %d\n", nstrips); /* if more than one offset, we'll find it in scrat of course */ if (!remote_flag) { strips = &offset; *strips = xq; } else { /* we have to stash the strip addresses, note that they might be shorts */ switch (tiff_type) { case TIFF_SHORT: nq = mq; mq = 2*mq; break; case TIFF_LONG: break; default: printf("bad type for STRIPOFFSETS\n"); goto a_bad_end; } strips = malloc(mq); if (!strips) { execute_error(123); goto a_bad_end; } strip_malloc = strips; /* save address for free */ if (tiff_type == TIFF_LONG) bcopy(scrat, strips, mq); else { /* the hard way */ pint = strips; pshort = (short *) scrat; while (nq--) *pint++ = ((int) *pshort++); } } break; case TIFFTAG_SAMPLESPERPIXEL: if (tiff_count != 1) goto a_bad_end; sampleperpixel = xq; break; case TIFFTAG_ROWSPERSTRIP: if (tiff_count != 1) goto a_bad_end; rowsperstrip = xq; break; case TIFFTAG_STRIPBYTECOUNTS: nstripbytecounts = tiff_count; if (!remote_flag) { stripbytecounts = &count; *stripbytecounts = xq; } else { /* we have to stash the counts, note that they might be shorts */ switch (tiff_type) { case TIFF_SHORT: nq = mq; mq = 2*mq; break; case TIFF_LONG: break; default: printf("bad type for STRIPBYTECOUNTS\n"); goto a_bad_end; } stripbytecounts = malloc(mq); if (!stripbytecounts) { execute_error(123); goto a_bad_end; } stripbytes_malloc = stripbytecounts; /* save address for free */ if (tiff_type == TIFF_LONG) bcopy(scrat, stripbytecounts, mq); else { /* the hard way */ pint = stripbytecounts; pshort = (short *) scrat; while (nq--) *pint++ =(int) *pshort++; } } break; case TIFFTAG_COLORMAP: /* a psuedo colormap, size is normally 3*256 shorts */ /* but convert if we find bytes instead */ ncolors = tiff_count; /* these should always be remote */ switch (tiff_type) { case TIFF_BYTE: nq = mq; mq = 2*mq; break; case TIFF_SHORT: break; default: printf("bad type for COLORMAP\n"); goto a_bad_end; } colormap = malloc(mq); if (!colormap) { execute_error(123); goto a_bad_end; } color_malloc = 1; if (tiff_type == TIFF_SHORT) bcopy(scrat, colormap, mq); else { /* the hard way, have to scale up also */ pshort = colormap; p = (char *) scrat; while (nq--) *pshort++ =((short) *p++) << 8; } /* now, define a colormap array for this, an alternate approach would be to convert to rgb triplets but this way we give the user more flexibility (and work!), this is done in this silly way (2 steps) to make it easier to change later if I change my mind or want to add an option */ iq = find_sym(tiff_colormap); ndim =2; dim[0] = 3; dim[1] = ncolors/3; if (redef_array(iq, 0, ndim, dim) != 1) goto a_bad_end; h = (struct ahead *) sym[iq].spec.array.ptr; p = (char *) ((char *)h + sizeof(struct ahead)); /* after we ensured that the TIFF color map was in the TIFF short format, we now convert to our internal byte format */ pshort = colormap; nq = 3*(ncolors/3); while (nq--) *p++ =(unsigned char) ((*pshort++)>>8); break; case TIFFTAG_ORIENTATION: if (tiff_count != 1) goto a_bad_end; orient = xq; break; case TIFFTAG_PLANARCONFIG: if (tiff_count != 1) goto a_bad_end; planarconfig = xq; break; default: printf("unprocessed tag %d\n", tiff_tag); } } printf("image nx, ny = %d x %d, photometric = %d\n", nx,ny, photometric); printf("bits per sample = %d, # strips = %d, rows per = %d\n", nbits,nstrips,rowsperstrip); printf("sampleperpixel = %d, nstripbytecounts = %d\n", sampleperpixel, nstripbytecounts); printf("planarconfig = %d, orientation = %d\n", planarconfig, orient); /* use our offsets to access the image */ if (nstripbytecounts != nstrips) { printf("mismatch in strips\n"); goto a_bad_end; } /* setup our internal array, several possibilities */ if (photometric == 2) { ndim = 3; dim[0] = 3; dim[1] = nx; dim[2] = ny; } else { ndim =2; dim[0] = nx; dim[1] = ny; } switch (nbits) { case 8: type = 0; break; case 16: type = 1; break; default: printf("sorry, unsupported bits/pixel = %d\n", nbits); goto a_bad_end; break; } iq = ps[0]; if ( redef_array(iq, type, ndim, dim) != 1 ) goto a_bad_end; h = (struct ahead *) sym[iq].spec.array.ptr; p = (char *) ((char *)h + sizeof(struct ahead)); /* provided the data isn't compressed, we can usually read directly into the array rather than defining a strip buffer */ if (compress_flag != 1) goto a_bad_end; while (nstrips--) { /* position file and read for this strip */ //printf("offset, count = %#x, %d\n", *strips, *stripbytecounts); if (fseek(fin, *strips++, SEEK_SET) ) goto a_bad_end; mq = *stripbytecounts++; if (fread(p,1,mq,fin) != mq ) goto a_bad_end; p += mq; } the_end: if (color_malloc) free(colormap); if (strip_malloc) free(strip_malloc); if (stripbytes_malloc) free(stripbytes_malloc); if (tags) free(tags); fclose(fin); return return_stat; a_bad_end: printf("error reading TIFF file\n"); return_stat = -1; goto the_end; } /*------------------------------------------------------------------------- */