| 1 | #include "f2c.h" |
| 2 | |
| 3 | /* |
| 4 | * getenv - f77 subroutine to return environment variables |
| 5 | * |
| 6 | * called by: |
| 7 | * call getenv (ENV_NAME, char_var) |
| 8 | * where: |
| 9 | * ENV_NAME is the name of an environment variable |
| 10 | * char_var is a character variable which will receive |
| 11 | * the current value of ENV_NAME, or all blanks |
| 12 | * if ENV_NAME is not defined |
| 13 | */ |
| 14 | |
| 15 | #ifdef KR_headers |
| 16 | VOID getenv_(fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; |
| 17 | #else |
| 18 | void getenv_(char *fname, char *value, ftnlen flen, ftnlen vlen) |
| 19 | #endif |
| 20 | { |
| 21 | extern char **environ; |
| 22 | register char *ep, *fp, *flast; |
| 23 | register char **env = environ; |
| 24 | |
| 25 | flast = fname + flen; |
| 26 | for(fp = fname ; fp < flast ; ++fp) |
| 27 | if(*fp == ' ') |
| 28 | { |
| 29 | flast = fp; |
| 30 | break; |
| 31 | } |
| 32 | |
| 33 | while (ep = *env++) |
| 34 | { |
| 35 | for(fp = fname; fp<flast ; ) |
| 36 | if(*fp++ != *ep++) |
| 37 | goto endloop; |
| 38 | |
| 39 | if(*ep++ == '=') { /* copy right hand side */ |
| 40 | while( *ep && --vlen>=0 ) |
| 41 | *value++ = *ep++; |
| 42 | |
| 43 | goto blank; |
| 44 | } |
| 45 | endloop: ; |
| 46 | } |
| 47 | |
| 48 | blank: |
| 49 | while( --vlen >= 0 ) |
| 50 | *value++ = ' '; |
| 51 | } |