Logical FATR srtdb_open_(_fcd filename, _fcd mode, Integer *handle)
{
int flen = _fcdlen(filename);
int mlen = _fcdlen(mode);
#else
Logical FATR srtdb_open_(const char *filename, const char *mode, Integer *handle,
const Integer flen, const Integer mlen)
{
#endif
char fbuf[256], mbuf[256];
int hbuf;
if (!fortchar_to_string(filename, flen, fbuf, sizeof(fbuf))) {
(void) fprintf(stderr, "srtdb_open: fbuf is too small, need=%d\n",
(int) flen);
return FORTRAN_FALSE;
}
if (!fortchar_to_string(mode, mlen, mbuf, sizeof(mbuf))) {
(void) fprintf(stderr, "srtdb_open: mbuf is too small, need=%d\n",
(int) mlen);
return FORTRAN_FALSE;
}
if (srtdb_open(fbuf, mbuf, &hbuf)) {
*handle = (Integer) hbuf;
return FORTRAN_TRUE;
}
else {
return FORTRAN_FALSE;
}
}
void FATR util_fadvise_noreuse_(const char *fort_fname, int flen){
char buf[1024];
if (!fortchar_to_string(fort_fname, flen, buf, sizeof(buf)))
GA_Error("util_fadvise: fortchar_to_string failed for fname",0);
(void) FATR util_fadvise(buf, POSIX_FADV_NOREUSE);
}
Integer FATR eaf_stat_(_fcd p, Integer *avail_kb, _fcd fst)
{
char *path = _fcdtocp(p);
int pathlen = _fcdlen(p);
char *fstype = _fcdtocp(fst);
int fslen = _fcdlen(fst);
#else
Integer FATR eaf_stat_(const char *path, Integer *avail_kb, char *fstype,
int pathlen, int fslen)
{
#endif
char pbuf[1024];
char fbuf[32];
int code, kb;
if (!fortchar_to_string(path, pathlen, pbuf, sizeof(pbuf)))
return (Integer) EAF_ERR_TOO_LONG;
code = eaf_stat(pbuf, &kb, fbuf, sizeof(fbuf));
if (!code) {
if (!string_to_fortchar(fstype, fslen, fbuf))
return (Integer) EAF_ERR_TOO_SHORT;
*avail_kb = (double) kb;
}
return code;
}
Logical FATR srtdb_put_(const Integer *handle, _fcd name, const Integer *ma_type,
const Integer *nelem, const void *array)
{
int nlen = _fcdlen(name);
#else
Logical FATR srtdb_put_(const Integer *handle, const char *name, const Integer *ma_type,
const Integer *nelem, const void *array, const int nlen)
{
#endif
int hbuf = (int) *handle;
char nbuf[256];
int nelbuf;
int typebuf;
if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
(void) fprintf(stderr, "srtdb_put: nbuf is too small, need=%d\n",
nlen);
return FORTRAN_FALSE;
}
nelbuf = (int) *nelem;
typebuf= (int) *ma_type;
#ifdef DEBUG
printf("put: rtdb=%d, mat=%d, nel=%d, name=%s\n", hbuf, typebuf, nelbuf, nbuf);
fflush(stdout);
#endif
if (srtdb_put(hbuf, nbuf, typebuf, nelbuf, array))
return FORTRAN_TRUE;
else
return FORTRAN_FALSE;
}
void util_speak_(const char *string, int len)
#endif
{
#ifdef SPEECH
char buf[256];
if (!fortchar_to_string(string, len, buf, sizeof(buf)))
return;
util_speak(buf);
#endif
}
void FATR UTIL_FILE_UNLINK(_fcd input)
{
int lin = _fcdlen(input);
#else
void util_file_unlink_(const char *input, int lin)
{
#endif
char in[255];
if (!fortchar_to_string(input, lin, in, sizeof(in)))
GA_Error("util_file_unlink: fortchar_to_string failed for in",0);
util_file_unlink(in);
}
void util_speak_init_(const char *host, integer *fp, int len)
#endif
{
#ifdef SPEECH
char buf[256];
int p = (int) *fp;
if (!fortchar_to_string(host, len, buf, sizeof(buf)))
return;
util_speak_init(buf, p);
#endif
}
Integer FATR eaf_delete_(_fcd f)
{
char *fname = _fcdtocp(f);
int flen = _fcdlen(f);
#else
Integer FATR eaf_delete_(const char *fname, int flen)
{
#endif
char buf[1024];
if (!fortchar_to_string(fname, flen, buf, sizeof(buf)))
return (Integer) EAF_ERR_TOO_LONG;
return (Integer) eaf_delete(buf);
}
Logical FATR srtdb_get_info_(const Integer *handle, _fcd name,
Integer *ma_type, Integer *nelem, _fcd date)
{
int nlen = _fcdlen(name);
int dlen = _fcdlen(date);
#else
Logical FATR srtdb_get_info_(const Integer *handle, const char *name,
Integer *ma_type, Integer *nelem, char *date,
const int nlen, const int dlen)
{
#endif
int hbuf = (int) *handle;
char dbuf[26], nbuf[256];
int nelbuf, typebuf;
if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
(void) fprintf(stderr, "srtdb_get_info: nbuf is too small, need=%d\n",
nlen);
return FORTRAN_FALSE;
}
if (dlen < 24) {
(void) fprintf(stderr, "srtdb_get_info: date must be > character*24\n");
return FORTRAN_FALSE;
}
if (srtdb_get_info(hbuf, nbuf, &typebuf, &nelbuf, dbuf)) {
*ma_type = (Integer) typebuf;
*nelem = (Integer) nelbuf;
if (typebuf == MT_CHAR) /* Fortran is ignorant of trailing null char */
*nelem = *nelem - 1;
if (!string_to_fortchar(date, dlen, dbuf)) {
(void) fprintf(stderr, "srtdb_get_info: nbuf is too small, need=%d\n",
nlen);
return FORTRAN_FALSE;
}
return FORTRAN_TRUE;
}
else {
return FORTRAN_FALSE;
}
}
Logical FATR srtdb_close_(const Integer *handle, _fcd mode)
{
int mlen = _fcdlen(mode);
#else
Logical FATR srtdb_close_(const Integer *handle, const char *mode, const int mlen)
{
#endif
char mbuf[256];
int hbuf = (int) *handle;
if (!fortchar_to_string(mode, mlen, mbuf, sizeof(mbuf))) {
(void) fprintf(stderr, "srtdb_close: mbuf is too small, need=%d\n", mlen);
return FORTRAN_FALSE;
}
if (srtdb_close(hbuf, mbuf))
return FORTRAN_TRUE;
else
return FORTRAN_FALSE;
}
Integer FATR eaf_open_(_fcd f, Integer *type, Integer *fd)
{
char *fname = _fcdtocp(f);
int flen = _fcdlen(f);
#else
Integer FATR eaf_open_(const char *fname, Integer *type, Integer *fd, int flen)
{
#endif
char buf[1024];
int code, tmp;
if (!fortchar_to_string(fname, flen, buf, sizeof(buf)))
return (Integer) EAF_ERR_TOO_LONG;
code = eaf_open(buf, (int) *type, &tmp);
*fd = (Integer) tmp;
return (Integer)code;
}
Logical FATR srtdb_delete_(const Integer *handle, _fcd name)
{
int nlen = _fcdlen(name);
#else
Logical FATR srtdb_delete_(const Integer *handle, const char *name, const int nlen)
{
#endif
int hbuf = (int) *handle;
char nbuf[256];
if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
(void) fprintf(stderr, "srtdb_delete: nbuf is too small, need=%d\n",
nlen);
return FORTRAN_FALSE;
}
if (srtdb_delete(hbuf, nbuf))
return FORTRAN_TRUE;
else
return FORTRAN_FALSE;
}
Logical FATR srtdb_cget_(const Integer *handle, _fcd name,
const Integer *nelem,
_fcd farray)
{
int nlen = _fcdlen(name);
int alen = _fcdlen(farray);
char *array = _fcdtocp(farray);
#else
Logical FATR srtdb_cget_(const Integer *handle, const char *name,
const Integer *nelem,
char *array, const int nlen, const int alen)
{
#endif
/*
Read an array of Fortran character variables from the data base.
Put stored the array as follows:
. Each array element is striped of trailing blanks, terminated with CR,
. and appended to the list. The entire array must fit into abuf.
*/
int hbuf = (int) *handle;
char nbuf[256];
char abuf[20480];
/* char abuf[10240];*/
int nelbuf;
int typebuf;
int i;
char *next;
if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
(void) fprintf(stderr, "srtdb_cget: nbuf is too small, need=%d\n",
nlen);
return FORTRAN_FALSE;
}
nelbuf = sizeof(abuf);
typebuf= (int) MT_CHAR;
#ifdef DEBUG
printf("cget: rtdb=%d, mat=%d, nel=%d, name=%s\n", hbuf, typebuf, nelbuf, nbuf);
fflush(stdout);
#endif
if (!srtdb_get(hbuf, nbuf, typebuf, nelbuf, abuf))
return FORTRAN_FALSE; /* Not there */
for (i=0, next=strtok(abuf, "\n");
next;
i++, array+=alen, next=strtok((char *) 0, "\n")) {
#if defined(CRAY) && !defined(__crayx1)
_fcd element = _cptofcd(array, alen);
#elif defined(WIN32)
_fcd element;
element.string = array;
element.len = alen;
#elif defined(USE_FCD)
#error Do something about _fcd
#else
char *element = array;
#endif
if (i == *nelem) {
(void) fprintf(stderr, "srtdb_cget: array has too few elements\n");
(void) fprintf(stderr, "srtdb_cget: name was <<%s>>\n",name);
return FORTRAN_FALSE;
}
if (!string_to_fortchar(element, alen, next)) {
(void) fprintf(stderr, "srtdb_cget: array element is too small\n");
(void) fprintf(stderr, "srtdb_cget: name was <<%s>>\n",name);
return FORTRAN_FALSE;
}
}
return FORTRAN_TRUE;
}
Logical FATR srtdb_cput_(const Integer *handle, _fcd name,
const Integer *nelem,
_fcd farray)
{
int nlen = _fcdlen(name);
int alen = _fcdlen(farray);
char *array = _fcdtocp(farray);
#else
Logical FATR srtdb_cput_(const Integer *handle, const char *name,
const Integer *nelem,
const char *array, const int nlen, const int alen)
{
#endif
/*
Insert an array of Fortran character variables into the data base.
Each array element is striped of trailing blanks, terminated with CR,
and appended to the list. The entire array must fit into abuf.
*/
int hbuf = (int) *handle;
char nbuf[256];
char abuf[20480]=" ";
int nelbuf;
int typebuf;
int i, left;
char *next;
for (i=0, left=sizeof(abuf), next=abuf;
i<*nelem;
i++, array+=alen) {
#if defined(CRAY) && !defined(__crayx1)
_fcd element = _cptofcd(array, alen);
#elif defined(WIN32)
_fcd element;
element.string = array;
element.len = alen;
#elif defined(USE_FCD)
#error Do something about _fcd
#else
const char *element = array;
#endif
if (!fortchar_to_string(element, alen, next, left)) {
(void) fprintf(stderr, "srtdb_cput: abuf is too small, need=%d\n",
(int) (alen + sizeof(abuf) - left));
return FORTRAN_FALSE;
}
left -= strlen(next) + 1;
next += strlen(next) + 1;
if (i != (*nelem - 1))
*(next-1) = '\n';
}
if (!fortchar_to_string(name, nlen, nbuf, sizeof(nbuf))) {
(void) fprintf(stderr, "srtdb_cput: nbuf is too small, need=%d\n",
nlen);
return FORTRAN_FALSE;
}
nelbuf = strlen(abuf) + 1;
typebuf= (int) MT_CHAR;
#ifdef DEBUG
printf("cput: rtdb=%d, mat=%d, nel=%d, name=%s\n", hbuf, typebuf, nelbuf, nbuf);
fflush(stdout);
#endif
if (srtdb_put(hbuf, nbuf, typebuf, nelbuf, abuf))
return FORTRAN_TRUE;
else
return FORTRAN_FALSE;
}