[thirdparty/gcc.git] / libgfortran / io / intrinsics.c

/* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH 
   FTELL, TTYNAM and ISATTY intrinsics.
   Copyright (C) 2005, 2007, 2009, 2010, 2011 Free Software
   Foundation, Inc.

This file is part of the GNU Fortran runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "io.h"
#include "fbuf.h"
#include "unix.h"

#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif

#include <string.h>

static const int five = 5;
static const int six = 6;

extern int PREFIX(fgetc) (const int *, char *, gfc_charlen_type);
export_proto_np(PREFIX(fgetc));

int
PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
{
  int ret;
  gfc_unit * u = find_unit (*unit);

  if (u == NULL)
    return -1;

  fbuf_reset (u);
  if (u->mode == WRITING)
    {
      sflush (u->s);
      u->mode = READING;
    }

  memset (c, ' ', c_len);
  ret = sread (u->s, c, 1);
  unlock_unit (u);

  if (ret < 0)
    return ret;

  if (ret != 1)
    return -1;
  else
    return 0;
}


#define FGETC_SUB(kind) \
  extern void fgetc_i ## kind ## _sub \
    (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
  export_proto(fgetc_i ## kind ## _sub); \
  void fgetc_i ## kind ## _sub \
  (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
    { if (st != NULL) \
        *st = PREFIX(fgetc) (unit, c, c_len); \
      else \
        PREFIX(fgetc) (unit, c, c_len); }

FGETC_SUB(1)
FGETC_SUB(2)
FGETC_SUB(4)
FGETC_SUB(8)


extern int PREFIX(fget) (char *, gfc_charlen_type);
export_proto_np(PREFIX(fget));

int
PREFIX(fget) (char * c, gfc_charlen_type c_len)
{
  return PREFIX(fgetc) (&five, c, c_len);
}


#define FGET_SUB(kind) \
  extern void fget_i ## kind ## _sub \
    (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
  export_proto(fget_i ## kind ## _sub); \
  void fget_i ## kind ## _sub \
  (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
    { if (st != NULL) \
        *st = PREFIX(fgetc) (&five, c, c_len); \
      else \
        PREFIX(fgetc) (&five, c, c_len); }

FGET_SUB(1)
FGET_SUB(2)
FGET_SUB(4)
FGET_SUB(8)


extern int PREFIX(fputc) (const int *, char *, gfc_charlen_type);
export_proto_np(PREFIX(fputc));

int
PREFIX(fputc) (const int * unit, char * c,
	       gfc_charlen_type c_len __attribute__((unused)))
{
  ssize_t s;
  gfc_unit * u = find_unit (*unit);

  if (u == NULL)
    return -1;

  fbuf_reset (u);
  if (u->mode == READING)
    {
      sflush (u->s);
      u->mode = WRITING;
    }

  s = swrite (u->s, c, 1);
  unlock_unit (u);
  if (s < 0)
    return -1;
  return 0;
}


#define FPUTC_SUB(kind) \
  extern void fputc_i ## kind ## _sub \
    (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
  export_proto(fputc_i ## kind ## _sub); \
  void fputc_i ## kind ## _sub \
  (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
    { if (st != NULL) \
        *st = PREFIX(fputc) (unit, c, c_len); \
      else \
        PREFIX(fputc) (unit, c, c_len); }

FPUTC_SUB(1)
FPUTC_SUB(2)
FPUTC_SUB(4)
FPUTC_SUB(8)


extern int PREFIX(fput) (char *, gfc_charlen_type);
export_proto_np(PREFIX(fput));

int
PREFIX(fput) (char * c, gfc_charlen_type c_len)
{
  return PREFIX(fputc) (&six, c, c_len);
}


#define FPUT_SUB(kind) \
  extern void fput_i ## kind ## _sub \
    (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
  export_proto(fput_i ## kind ## _sub); \
  void fput_i ## kind ## _sub \
  (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
    { if (st != NULL) \
        *st = PREFIX(fputc) (&six, c, c_len); \
      else \
        PREFIX(fputc) (&six, c, c_len); }

FPUT_SUB(1)
FPUT_SUB(2)
FPUT_SUB(4)
FPUT_SUB(8)


/* SUBROUTINE FLUSH(UNIT)
   INTEGER, INTENT(IN), OPTIONAL :: UNIT  */

extern void flush_i4 (GFC_INTEGER_4 *);
export_proto(flush_i4);

void
flush_i4 (GFC_INTEGER_4 *unit)
{
  gfc_unit *us;

  /* flush all streams */
  if (unit == NULL)
    flush_all_units ();
  else
    {
      us = find_unit (*unit);
      if (us != NULL)
	{
	  sflush (us->s);
	  unlock_unit (us);
	}
    }
}


extern void flush_i8 (GFC_INTEGER_8 *);
export_proto(flush_i8);

void
flush_i8 (GFC_INTEGER_8 *unit)
{
  gfc_unit *us;

  /* flush all streams */
  if (unit == NULL)
    flush_all_units ();
  else
    {
      us = find_unit (*unit);
      if (us != NULL)
	{
	  sflush (us->s);
	  unlock_unit (us);
	}
    }
}

/* FSEEK intrinsic */

extern void fseek_sub (int *, GFC_IO_INT *, int *, int *);
export_proto(fseek_sub);

void
fseek_sub (int * unit, GFC_IO_INT * offset, int * whence, int * status)
{
  gfc_unit * u = find_unit (*unit);
  ssize_t result = -1;

  if (u != NULL && is_seekable(u->s))
    {
      result = sseek(u->s, *offset, *whence);

      unlock_unit (u);
    }

  if (status)
    *status = (result < 0 ? -1 : 0);
}


/* FTELL intrinsic */

static gfc_offset
gf_ftell (int unit)
{
  gfc_unit * u = find_unit (unit);
  if (u == NULL)
    return -1;
  int pos = fbuf_reset (u);
  if (pos != 0)
    sseek (u->s, pos, SEEK_CUR);
  gfc_offset ret = stell (u->s);
  unlock_unit (u);
  return ret;
}

extern size_t PREFIX(ftell) (int *);
export_proto_np(PREFIX(ftell));

size_t
PREFIX(ftell) (int * unit)
{
  return gf_ftell (*unit);
}

#define FTELL_SUB(kind) \
  extern void ftell_i ## kind ## _sub (int *, GFC_INTEGER_ ## kind *); \
  export_proto(ftell_i ## kind ## _sub); \
  void \
  ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \
  { \
    *offset = gf_ftell (*unit);			\
  }

FTELL_SUB(1)
FTELL_SUB(2)
FTELL_SUB(4)
FTELL_SUB(8)


/* LOGICAL FUNCTION ISATTY(UNIT)
   INTEGER, INTENT(IN) :: UNIT */

extern GFC_LOGICAL_4 isatty_l4 (int *);
export_proto(isatty_l4);

GFC_LOGICAL_4
isatty_l4 (int *unit)
{
  gfc_unit *u;
  GFC_LOGICAL_4 ret = 0;

  u = find_unit (*unit);
  if (u != NULL)
    {
      ret = (GFC_LOGICAL_4) stream_isatty (u->s);
      unlock_unit (u);
    }
  return ret;
}


extern GFC_LOGICAL_8 isatty_l8 (int *);
export_proto(isatty_l8);

GFC_LOGICAL_8
isatty_l8 (int *unit)
{
  gfc_unit *u;
  GFC_LOGICAL_8 ret = 0;

  u = find_unit (*unit);
  if (u != NULL)
    {
      ret = (GFC_LOGICAL_8) stream_isatty (u->s);
      unlock_unit (u);
    }
  return ret;
}


/* SUBROUTINE TTYNAM(UNIT,NAME)
   INTEGER,SCALAR,INTENT(IN) :: UNIT
   CHARACTER,SCALAR,INTENT(OUT) :: NAME */

extern void ttynam_sub (int *, char *, gfc_charlen_type);
export_proto(ttynam_sub);

void
ttynam_sub (int *unit, char * name, gfc_charlen_type name_len)
{
  gfc_unit *u;
  int nlen;
  int err = 1;

  u = find_unit (*unit);
  if (u != NULL)
    {
      err = stream_ttyname (u->s, name, name_len);
      if (err == 0)
	{
	  nlen = strlen (name);
	  memset (&name[nlen], ' ', name_len - nlen);
	}

      unlock_unit (u);
    }
  if (err != 0)
    memset (name, ' ', name_len);
}


extern void ttynam (char **, gfc_charlen_type *, int);
export_proto(ttynam);

void
ttynam (char ** name, gfc_charlen_type * name_len, int unit)
{
  gfc_unit *u;

  u = find_unit (unit);
  if (u != NULL)
    {
      *name = get_mem (TTY_NAME_MAX);
      int err = stream_ttyname (u->s, *name, TTY_NAME_MAX);
      if (err == 0)
	{
	  *name_len = strlen (*name);
	  unlock_unit (u);
	  return;
	}
      free (*name);
      unlock_unit (u);
    }

  *name_len = 0;
  *name = NULL;
}
Commit	Line	Data
0dce3ca1 FXC	1	/* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH
0dce3ca1 FXC	2	FTELL, TTYNAM and ISATTY intrinsics.
6a0f6e77 JB	3	Copyright (C) 2005, 2007, 2009, 2010, 2011 Free Software
6a0f6e77 JB	4	Foundation, Inc.
5d723e54	5
e76a3fde	6	This file is part of the GNU Fortran runtime library (libgfortran).
5d723e54 FXC	7
	8	Libgfortran is free software; you can redistribute it and/or
	9	modify it under the terms of the GNU General Public
	10	License as published by the Free Software Foundation; either
748086b7	11	version 3 of the License, or (at your option) any later version.
5d723e54 FXC	12
	13	Libgfortran is distributed in the hope that it will be useful,
	14	but WITHOUT ANY WARRANTY; without even the implied warranty of
	15	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	GNU General Public License for more details.
	17
748086b7 JJ	18	Under Section 7 of GPL version 3, you are granted additional
	19	permissions described in the GCC Runtime Library Exception, version
	20	3.1, as published by the Free Software Foundation.
	21
	22	You should have received a copy of the GNU General Public License and
	23	a copy of the GCC Runtime Library Exception along with this program;
	24	see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
	25	<http://www.gnu.org/licenses/>. */
5d723e54	26
36ae8a61	27	#include "io.h"
92cbdb68 JB	28	#include "fbuf.h"
92cbdb68 JB	29	#include "unix.h"
5d723e54	30
0dce3ca1 FXC	31	#ifdef HAVE_STDLIB_H
	32	#include <stdlib.h>
	33	#endif
	34
5d723e54 FXC	35	#include <string.h>
5d723e54 FXC	36
5d723e54 FXC	37	static const int five = 5;
	38	static const int six = 6;
	39
	40	extern int PREFIX(fgetc) (const int , char , gfc_charlen_type);
	41	export_proto_np(PREFIX(fgetc));
	42
	43	int
	44	PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
	45	{
	46	int ret;
5d723e54 FXC	47	gfc_unit * u = find_unit (*unit);
	48
	49	if (u == NULL)
	50	return -1;
	51
ee56ac9d JB	52	fbuf_reset (u);
	53	if (u->mode == WRITING)
	54	{
	55	sflush (u->s);
	56	u->mode = READING;
	57	}
	58
5d723e54	59	memset (c, ' ', c_len);
f9bfed22	60	ret = sread (u->s, c, 1);
401cd90a	61	unlock_unit (u);
5d723e54	62
7812c78c	63	if (ret < 0)
5d723e54 FXC	64	return ret;
5d723e54 FXC	65
7812c78c	66	if (ret != 1)
5d723e54 FXC	67	return -1;
	68	else
	69	return 0;
	70	}
	71
	72
	73	#define FGETC_SUB(kind) \
	74	extern void fgetc_i ## kind ## _sub \
	75	(const int , char , GFC_INTEGER_ ## kind *, gfc_charlen_type); \
	76	export_proto(fgetc_i ## kind ## _sub); \
	77	void fgetc_i ## kind ## _sub \
	78	(const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
	79	{ if (st != NULL) \
	80	*st = PREFIX(fgetc) (unit, c, c_len); \
	81	else \
	82	PREFIX(fgetc) (unit, c, c_len); }
	83
	84	FGETC_SUB(1)
	85	FGETC_SUB(2)
	86	FGETC_SUB(4)
	87	FGETC_SUB(8)
	88
	89
	90	extern int PREFIX(fget) (char *, gfc_charlen_type);
	91	export_proto_np(PREFIX(fget));
	92
	93	int
	94	PREFIX(fget) (char * c, gfc_charlen_type c_len)
	95	{
	96	return PREFIX(fgetc) (&five, c, c_len);
	97	}
	98
	99
	100	#define FGET_SUB(kind) \
	101	extern void fget_i ## kind ## _sub \
	102	(char , GFC_INTEGER_ ## kind , gfc_charlen_type); \
	103	export_proto(fget_i ## kind ## _sub); \
	104	void fget_i ## kind ## _sub \
	105	(char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
	106	{ if (st != NULL) \
	107	*st = PREFIX(fgetc) (&five, c, c_len); \
	108	else \
	109	PREFIX(fgetc) (&five, c, c_len); }
	110
	111	FGET_SUB(1)
	112	FGET_SUB(2)
	113	FGET_SUB(4)
	114	FGET_SUB(8)
	115
	116
	117
	118	extern int PREFIX(fputc) (const int , char , gfc_charlen_type);
	119	export_proto_np(PREFIX(fputc));
	120
	121	int
	122	PREFIX(fputc) (const int * unit, char * c,
	123	gfc_charlen_type c_len __attribute__((unused)))
	124	{
7812c78c	125	ssize_t s;
5d723e54 FXC	126	gfc_unit * u = find_unit (*unit);
	127
	128	if (u == NULL)
	129	return -1;
	130
ee56ac9d JB	131	fbuf_reset (u);
	132	if (u->mode == READING)
	133	{
	134	sflush (u->s);
	135	u->mode = WRITING;
	136	}
	137
7812c78c	138	s = swrite (u->s, c, 1);
401cd90a	139	unlock_unit (u);
7812c78c JD	140	if (s < 0)
	141	return -1;
	142	return 0;
5d723e54 FXC	143	}
	144
	145
	146	#define FPUTC_SUB(kind) \
	147	extern void fputc_i ## kind ## _sub \
	148	(const int , char , GFC_INTEGER_ ## kind *, gfc_charlen_type); \
	149	export_proto(fputc_i ## kind ## _sub); \
	150	void fputc_i ## kind ## _sub \
	151	(const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
	152	{ if (st != NULL) \
	153	*st = PREFIX(fputc) (unit, c, c_len); \
	154	else \
	155	PREFIX(fputc) (unit, c, c_len); }
	156
	157	FPUTC_SUB(1)
	158	FPUTC_SUB(2)
	159	FPUTC_SUB(4)
	160	FPUTC_SUB(8)
	161
	162
	163	extern int PREFIX(fput) (char *, gfc_charlen_type);
	164	export_proto_np(PREFIX(fput));
	165
	166	int
	167	PREFIX(fput) (char * c, gfc_charlen_type c_len)
	168	{
	169	return PREFIX(fputc) (&six, c, c_len);
	170	}
	171
	172
	173	#define FPUT_SUB(kind) \
	174	extern void fput_i ## kind ## _sub \
	175	(char , GFC_INTEGER_ ## kind , gfc_charlen_type); \
	176	export_proto(fput_i ## kind ## _sub); \
	177	void fput_i ## kind ## _sub \
	178	(char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
	179	{ if (st != NULL) \
	180	*st = PREFIX(fputc) (&six, c, c_len); \
	181	else \
	182	PREFIX(fputc) (&six, c, c_len); }
	183
	184	FPUT_SUB(1)
	185	FPUT_SUB(2)
	186	FPUT_SUB(4)
	187	FPUT_SUB(8)
	188
0dce3ca1 FXC	189
	190	/* SUBROUTINE FLUSH(UNIT)
	191	INTEGER, INTENT(IN), OPTIONAL :: UNIT */
	192
	193	extern void flush_i4 (GFC_INTEGER_4 *);
	194	export_proto(flush_i4);
	195
	196	void
	197	flush_i4 (GFC_INTEGER_4 *unit)
	198	{
	199	gfc_unit *us;
	200
	201	/* flush all streams */
	202	if (unit == NULL)
	203	flush_all_units ();
	204	else
	205	{
	206	us = find_unit (*unit);
	207	if (us != NULL)
	208	{
7812c78c	209	sflush (us->s);
0dce3ca1 FXC	210	unlock_unit (us);
	211	}
	212	}
	213	}
	214
	215
	216	extern void flush_i8 (GFC_INTEGER_8 *);
	217	export_proto(flush_i8);
	218
	219	void
	220	flush_i8 (GFC_INTEGER_8 *unit)
	221	{
	222	gfc_unit *us;
	223
	224	/* flush all streams */
	225	if (unit == NULL)
	226	flush_all_units ();
	227	else
	228	{
	229	us = find_unit (*unit);
	230	if (us != NULL)
	231	{
7812c78c	232	sflush (us->s);
0dce3ca1 FXC	233	unlock_unit (us);
	234	}
	235	}
	236	}
	237
dcdc26df DF	238	/* FSEEK intrinsic */
	239
	240	extern void fseek_sub (int , GFC_IO_INT , int , int );
	241	export_proto(fseek_sub);
	242
	243	void
	244	fseek_sub (int * unit, GFC_IO_INT * offset, int * whence, int * status)
	245	{
	246	gfc_unit * u = find_unit (*unit);
7812c78c	247	ssize_t result = -1;
dcdc26df DF	248
	249	if (u != NULL && is_seekable(u->s))
	250	{
7812c78c	251	result = sseek(u->s, offset, whence);
dcdc26df DF	252
	253	unlock_unit (u);
	254	}
	255
	256	if (status)
7812c78c	257	*status = (result < 0 ? -1 : 0);
dcdc26df DF	258	}
	259
	260
0dce3ca1 FXC	261
	262	/* FTELL intrinsic */
	263
b879c108 JB	264	static gfc_offset
	265	gf_ftell (int unit)
	266	{
	267	gfc_unit * u = find_unit (unit);
	268	if (u == NULL)
	269	return -1;
	270	int pos = fbuf_reset (u);
	271	if (pos != 0)
	272	sseek (u->s, pos, SEEK_CUR);
	273	gfc_offset ret = stell (u->s);
	274	unlock_unit (u);
	275	return ret;
	276	}
	277
0dce3ca1 FXC	278	extern size_t PREFIX(ftell) (int *);
	279	export_proto_np(PREFIX(ftell));
	280
	281	size_t
	282	PREFIX(ftell) (int * unit)
	283	{
b879c108	284	return gf_ftell (*unit);
0dce3ca1 FXC	285	}
	286
	287	#define FTELL_SUB(kind) \
	288	extern void ftell_i ## kind ## _sub (int , GFC_INTEGER_ ## kind ); \
	289	export_proto(ftell_i ## kind ## _sub); \
	290	void \
	291	ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \
	292	{ \
b879c108	293	offset = gf_ftell (unit); \
0dce3ca1 FXC	294	}
	295
	296	FTELL_SUB(1)
	297	FTELL_SUB(2)
	298	FTELL_SUB(4)
	299	FTELL_SUB(8)
	300
	301
	302
	303	/* LOGICAL FUNCTION ISATTY(UNIT)
	304	INTEGER, INTENT(IN) :: UNIT */
	305
	306	extern GFC_LOGICAL_4 isatty_l4 (int *);
	307	export_proto(isatty_l4);
	308
	309	GFC_LOGICAL_4
	310	isatty_l4 (int *unit)
	311	{
	312	gfc_unit *u;
	313	GFC_LOGICAL_4 ret = 0;
	314
	315	u = find_unit (*unit);
	316	if (u != NULL)
	317	{
	318	ret = (GFC_LOGICAL_4) stream_isatty (u->s);
	319	unlock_unit (u);
	320	}
	321	return ret;
	322	}
	323
	324
	325	extern GFC_LOGICAL_8 isatty_l8 (int *);
	326	export_proto(isatty_l8);
	327
	328	GFC_LOGICAL_8
	329	isatty_l8 (int *unit)
	330	{
	331	gfc_unit *u;
	332	GFC_LOGICAL_8 ret = 0;
	333
	334	u = find_unit (*unit);
	335	if (u != NULL)
	336	{
	337	ret = (GFC_LOGICAL_8) stream_isatty (u->s);
	338	unlock_unit (u);
	339	}
	340	return ret;
	341	}
	342
	343
	344	/* SUBROUTINE TTYNAM(UNIT,NAME)
	345	INTEGER,SCALAR,INTENT(IN) :: UNIT
	346	CHARACTER,SCALAR,INTENT(OUT) :: NAME */
	347
	348	extern void ttynam_sub (int , char , gfc_charlen_type);
	349	export_proto(ttynam_sub);
	350
	351	void
	352	ttynam_sub (int unit, char name, gfc_charlen_type name_len)
	353	{
	354	gfc_unit *u;
6a0f6e77 JB	355	int nlen;
6a0f6e77 JB	356	int err = 1;
0dce3ca1	357
0dce3ca1 FXC	358	u = find_unit (*unit);
	359	if (u != NULL)
	360	{
6a0f6e77 JB	361	err = stream_ttyname (u->s, name, name_len);
6a0f6e77 JB	362	if (err == 0)
0dce3ca1	363	{
6a0f6e77 JB	364	nlen = strlen (name);
6a0f6e77 JB	365	memset (&name[nlen], ' ', name_len - nlen);
0dce3ca1	366	}
6a0f6e77	367
0dce3ca1 FXC	368	unlock_unit (u);
0dce3ca1 FXC	369	}
6a0f6e77 JB	370	if (err != 0)
6a0f6e77 JB	371	memset (name, ' ', name_len);
0dce3ca1 FXC	372	}
	373
	374
	375	extern void ttynam (char *, gfc_charlen_type , int);
	376	export_proto(ttynam);
	377
	378	void
	379	ttynam (char ** name, gfc_charlen_type * name_len, int unit)
	380	{
	381	gfc_unit *u;
	382
	383	u = find_unit (unit);
	384	if (u != NULL)
	385	{
6a0f6e77 JB	386	*name = get_mem (TTY_NAME_MAX);
	387	int err = stream_ttyname (u->s, *name, TTY_NAME_MAX);
	388	if (err == 0)
0dce3ca1 FXC	389	{
0dce3ca1 FXC	390	name_len = strlen (name);
0dce3ca1 FXC	391	unlock_unit (u);
	392	return;
	393	}
6a0f6e77	394	free (*name);
0dce3ca1 FXC	395	unlock_unit (u);
	396	}
	397
	398	*name_len = 0;
	399	*name = NULL;
	400	}