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

   1 /*
   2  * $Id$
   3  *
   4  * $Log$
   5  * Revision 1.3  1997/09/02 14:26:36  mclareni
   6  * WINNT correction
   7  *
   8  * Revision 1.2  1997/02/04 17:34:20  mclareni
   9  * Merge Winnt and 97a versions
  10  *
  11  * Revision 1.1.1.1.2.1  1997/01/21 11:29:29  mclareni
  12  * All mods for Winnt 96a on winnt branch
  13  *
  14  * Revision 1.1.1.1  1996/02/15 17:49:23  mclareni
  15  * Kernlib
  16  *
  17  */
  18 #include "kerngen/pilot.h"
  19 #include "kerngen/fortranc.h"
  20
  21 /*>    ROUTINE GETWDI
  22   CERN PROGLIB# Z265    GETWDI          .VERSION KERNFOR  4.38  931108
  23   ORIG. 22/02/91, JZ
  24   Fortran interface routine to getwd
  25
  26       CALL GETWDF (TEXT*)
  27
  28       returns the name of the c.w.d. in TEXT
  29       ISLATE(1) returns its lenth NTEXT
  30 */
  31 #include <stdio.h>
  32 #ifdef WIN32
  33 #include <direct.h>
  34 # ifndef getcwd
  35 #   define getcwd _getcwd
  36 # endif
  37 #endif
  38 #include "kerngen/fortchar.h"
  39 #if defined(CERNLIB_QX_SC)
  40 void type_of_call getwdi_(fname, lgname)
  41 #endif
  42 #if defined(CERNLIB_QXNO_SC)
  43 void type_of_call getwdi(fname, lgname)
  44 #endif
  45 #if defined(CERNLIB_QXCAPT)
  46 # ifdef CERNLIB_MSSTDCALL
  47     void type_of_call GETWDI(fname, len_fname, lgname)
  48     int len_fname;
  49 #  else
  50     void type_of_call GETWDI(fname, lgname)
  51 #  endif
  52 #endif
  53 #if defined(CERNLIB_QMCRY)
  54       _fcd fname;
  55 #endif
  56 #if !defined(CERNLIB_QMCRY)
  57       char *fname;
  58 #endif
  59       int  *lgname;
  60 {
  61       char *malloc();
  62       char *ptalc, *pttext;
  63       int  fchput();
  64       int  nalc;
  65 #if !defined(CERNLIB_QGETCWD)
  66       char *getwd();
  67 #endif
  68 #if defined(CERNLIB_QGETCWD)
  69       char *getcwd();
  70       int  nsize;
  71 #endif
  72
  73       pttext = NULL;
  74       nalc   = 2048;
  75       ptalc  = malloc(nalc);
  76       if (ptalc == NULL)           goto out;
  77
  78 #if !defined(CERNLIB_QGETCWD)
  79       pttext = getwd (ptalc);
  80 #endif
  81 #if defined(CERNLIB_QGETCWD)
  82       nsize  = nalc;
  83       pttext = getcwd (ptalc, nsize);
  84 #endif
  85
  86 out:  *lgname = fchput (pttext,fname,*lgname);
  87       if (ptalc != NULL)   free(ptalc);
  88       return;
  89 }
  90 /*> END <----------------------------------------------------------*/