diff options
Diffstat (limited to 'gnu/lib/libf2c/libF77/getenv_.c')
-rw-r--r-- | gnu/lib/libf2c/libF77/getenv_.c | 56 |
1 files changed, 56 insertions, 0 deletions
diff --git a/gnu/lib/libf2c/libF77/getenv_.c b/gnu/lib/libf2c/libF77/getenv_.c new file mode 100644 index 00000000000..4d0b7cf7b04 --- /dev/null +++ b/gnu/lib/libf2c/libF77/getenv_.c @@ -0,0 +1,56 @@ +#include "f2c.h" +#undef abs +#ifdef KR_headers +extern char *F77_aloc(), *getenv(); +#else +#include <stdlib.h> +#include <string.h> +extern char *F77_aloc(ftnlen, char*); +#endif + +/* + * getenv - f77 subroutine to return environment variables + * + * called by: + * call getenv (ENV_NAME, char_var) + * where: + * ENV_NAME is the name of an environment variable + * char_var is a character variable which will receive + * the current value of ENV_NAME, or all blanks + * if ENV_NAME is not defined + */ + +#ifdef KR_headers + VOID +G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; +#else + void +G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen) +#endif +{ + char buf[256], *ep, *fp; + integer i; + + if (flen <= 0) + goto add_blanks; + for(i = 0; i < sizeof(buf); i++) { + if (i == flen || (buf[i] = fname[i]) == ' ') { + buf[i] = 0; + ep = getenv(buf); + goto have_ep; + } + } + while(i < flen && fname[i] != ' ') + i++; + strncpy(fp = F77_aloc(i+1, "getenv_"), fname, (int)i); + fp[i] = 0; + ep = getenv(fp); + free(fp); + have_ep: + if (ep) + while(*ep && vlen-- > 0) + *value++ = *ep++; + add_blanks: + while(vlen-- > 0) + *value++ = ' '; + } |