MINICERN/packlib/kernlib/kerngen/ccgen/setenvsy5.c

   1 /*
   2  * $Id$
   3  *
   4  * $Log$
   5  * Revision 1.2  1997/02/04 17:34:39  mclareni
   6  * Merge Winnt and 97a versions
   7  *
   8  * Revision 1.1.1.1.2.1  1997/01/21 11:29:40  mclareni
   9  * All mods for Winnt 96a on winnt branch
  10  *
  11  * Revision 1.1.1.1  1996/02/15 17:49:26  mclareni
  12  * Kernlib
  13  *
  14  */
  15 /*>    ROUTINE SETENI
  16   CERN PROGLIB# Z265    SETENI          .VERSION KERNFOR  4.36  930602
  17   ORIG. 22/02/91, JZ
  18   Fortran interface routine to putenv
  19
  20       CALL SETENVF (NAME, TEXT*)
  21
  22           NAME  the name of the environment variable,
  23           TEXT  the value to be assigned
  24 */
  25 #include <stdio.h>
  26 #include "kerngen/fortchar.h"
  27 #include "kerngen/fortranc.h"
  28
  29 #if defined(CERNLIB_QX_SC)
  30 int type_of_call seteni_(fname, ftext, lgname, lgtext)
  31 #endif
  32 #if defined(CERNLIB_QXNO_SC)
  33 int type_of_call seteni(fname, ftext, lgname, lgtext)
  34 #endif
  35 #if defined(CERNLIB_QXCAPT)
  36 int type_of_call SETENI(fname, ftext, lgname, lgtext)
  37 #endif
  38 #if defined(CERNLIB_QMCRY)
  39       _fcd  fname,  ftext;
  40 #endif
  41 #if !defined(CERNLIB_QMCRY)
  42       char *fname, *ftext;
  43 #endif
  44       int  *lgtext, *lgname;
  45 {
  46       char *ptname, *pttext, *pts, *ptt, *fchtak();
  47       int  nname, ntext, istat, putenv();
  48       int  ntot, j;
  49
  50       istat = -1;
  51       nname = *lgname;
  52       ntext = *lgtext;
  53       ntot  = nname + 1 + ntext;
  54
  55       ptname = fchtak(fname,ntot);
  56       if (ptname == NULL)          goto out1;
  57       pttext = fchtak(ftext,ntext);
  58       if (pttext == NULL)          goto out2;
  59
  60       pts = pttext;
  61       ptt = ptname + nname;
  62       *ptt++ = '=';
  63       for (j = 0; j <= ntext; j++) *ptt++ = *pts++;
  64
  65       istat = putenv (ptname);
  66       free(pttext);
  67       if (istat == 0)              return 0;
  68
  69 out2: free(ptname);
  70 out1: return istat;
  71 }
  72 /*> END <----------------------------------------------------------*/