[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"
#include <stdlib.h>
#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)
    {
      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"
0dce3ca1	30	#include <stdlib.h>
5d723e54 FXC	31	#include <string.h>
5d723e54 FXC	32
74544378	33
5d723e54 FXC	34	static const int five = 5;
	35	static const int six = 6;
	36
	37	extern int PREFIX(fgetc) (const int , char , gfc_charlen_type);
	38	export_proto_np(PREFIX(fgetc));
	39
	40	int
	41	PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
	42	{
	43	int ret;
5d723e54 FXC	44	gfc_unit * u = find_unit (*unit);
	45
	46	if (u == NULL)
	47	return -1;
	48
ee56ac9d JB	49	fbuf_reset (u);
	50	if (u->mode == WRITING)
	51	{
	52	sflush (u->s);
	53	u->mode = READING;
	54	}
	55
5d723e54	56	memset (c, ' ', c_len);
f9bfed22	57	ret = sread (u->s, c, 1);
401cd90a	58	unlock_unit (u);
5d723e54	59
7812c78c	60	if (ret < 0)
5d723e54 FXC	61	return ret;
5d723e54 FXC	62
7812c78c	63	if (ret != 1)
5d723e54 FXC	64	return -1;
	65	else
	66	return 0;
	67	}
	68
	69
	70	#define FGETC_SUB(kind) \
	71	extern void fgetc_i ## kind ## _sub \
	72	(const int , char , GFC_INTEGER_ ## kind *, gfc_charlen_type); \
	73	export_proto(fgetc_i ## kind ## _sub); \
	74	void fgetc_i ## kind ## _sub \
	75	(const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
	76	{ if (st != NULL) \
	77	*st = PREFIX(fgetc) (unit, c, c_len); \
	78	else \
	79	PREFIX(fgetc) (unit, c, c_len); }
	80
	81	FGETC_SUB(1)
	82	FGETC_SUB(2)
	83	FGETC_SUB(4)
	84	FGETC_SUB(8)
	85
	86
	87	extern int PREFIX(fget) (char *, gfc_charlen_type);
	88	export_proto_np(PREFIX(fget));
	89
	90	int
	91	PREFIX(fget) (char * c, gfc_charlen_type c_len)
	92	{
	93	return PREFIX(fgetc) (&five, c, c_len);
	94	}
	95
	96
	97	#define FGET_SUB(kind) \
	98	extern void fget_i ## kind ## _sub \
	99	(char , GFC_INTEGER_ ## kind , gfc_charlen_type); \
	100	export_proto(fget_i ## kind ## _sub); \
	101	void fget_i ## kind ## _sub \
	102	(char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
	103	{ if (st != NULL) \
	104	*st = PREFIX(fgetc) (&five, c, c_len); \
	105	else \
	106	PREFIX(fgetc) (&five, c, c_len); }
	107
	108	FGET_SUB(1)
	109	FGET_SUB(2)
	110	FGET_SUB(4)
	111	FGET_SUB(8)
	112
	113
	114
	115	extern int PREFIX(fputc) (const int , char , gfc_charlen_type);
	116	export_proto_np(PREFIX(fputc));
	117
	118	int
	119	PREFIX(fputc) (const int * unit, char * c,
	120	gfc_charlen_type c_len __attribute__((unused)))
	121	{
7812c78c	122	ssize_t s;
5d723e54 FXC	123	gfc_unit * u = find_unit (*unit);
	124
	125	if (u == NULL)
	126	return -1;
	127
ee56ac9d JB	128	fbuf_reset (u);
	129	if (u->mode == READING)
	130	{
	131	sflush (u->s);
	132	u->mode = WRITING;
	133	}
	134
7812c78c	135	s = swrite (u->s, c, 1);
401cd90a	136	unlock_unit (u);
7812c78c JD	137	if (s < 0)
	138	return -1;
	139	return 0;
5d723e54 FXC	140	}
	141
	142
	143	#define FPUTC_SUB(kind) \
	144	extern void fputc_i ## kind ## _sub \
	145	(const int , char , GFC_INTEGER_ ## kind *, gfc_charlen_type); \
	146	export_proto(fputc_i ## kind ## _sub); \
	147	void fputc_i ## kind ## _sub \
	148	(const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
	149	{ if (st != NULL) \
	150	*st = PREFIX(fputc) (unit, c, c_len); \
	151	else \
	152	PREFIX(fputc) (unit, c, c_len); }
	153
	154	FPUTC_SUB(1)
	155	FPUTC_SUB(2)
	156	FPUTC_SUB(4)
	157	FPUTC_SUB(8)
	158
	159
	160	extern int PREFIX(fput) (char *, gfc_charlen_type);
	161	export_proto_np(PREFIX(fput));
	162
	163	int
	164	PREFIX(fput) (char * c, gfc_charlen_type c_len)
	165	{
	166	return PREFIX(fputc) (&six, c, c_len);
	167	}
	168
	169
	170	#define FPUT_SUB(kind) \
	171	extern void fput_i ## kind ## _sub \
	172	(char , GFC_INTEGER_ ## kind , gfc_charlen_type); \
	173	export_proto(fput_i ## kind ## _sub); \
	174	void fput_i ## kind ## _sub \
	175	(char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
	176	{ if (st != NULL) \
	177	*st = PREFIX(fputc) (&six, c, c_len); \
	178	else \
	179	PREFIX(fputc) (&six, c, c_len); }
	180
	181	FPUT_SUB(1)
	182	FPUT_SUB(2)
	183	FPUT_SUB(4)
	184	FPUT_SUB(8)
	185
0dce3ca1 FXC	186
	187	/* SUBROUTINE FLUSH(UNIT)
	188	INTEGER, INTENT(IN), OPTIONAL :: UNIT */
	189
	190	extern void flush_i4 (GFC_INTEGER_4 *);
	191	export_proto(flush_i4);
	192
	193	void
	194	flush_i4 (GFC_INTEGER_4 *unit)
	195	{
	196	gfc_unit *us;
	197
	198	/* flush all streams */
	199	if (unit == NULL)
	200	flush_all_units ();
	201	else
	202	{
	203	us = find_unit (*unit);
	204	if (us != NULL)
	205	{
7812c78c	206	sflush (us->s);
0dce3ca1 FXC	207	unlock_unit (us);
	208	}
	209	}
	210	}
	211
	212
	213	extern void flush_i8 (GFC_INTEGER_8 *);
	214	export_proto(flush_i8);
	215
	216	void
	217	flush_i8 (GFC_INTEGER_8 *unit)
	218	{
	219	gfc_unit *us;
	220
	221	/* flush all streams */
	222	if (unit == NULL)
	223	flush_all_units ();
	224	else
	225	{
	226	us = find_unit (*unit);
	227	if (us != NULL)
	228	{
7812c78c	229	sflush (us->s);
0dce3ca1 FXC	230	unlock_unit (us);
	231	}
	232	}
	233	}
	234
dcdc26df DF	235	/* FSEEK intrinsic */
	236
	237	extern void fseek_sub (int , GFC_IO_INT , int , int );
	238	export_proto(fseek_sub);
	239
	240	void
	241	fseek_sub (int * unit, GFC_IO_INT * offset, int * whence, int * status)
	242	{
	243	gfc_unit * u = find_unit (*unit);
7812c78c	244	ssize_t result = -1;
dcdc26df	245
7d5ee219	246	if (u != NULL)
dcdc26df	247	{
7812c78c	248	result = sseek(u->s, offset, whence);
dcdc26df DF	249
	250	unlock_unit (u);
	251	}
	252
	253	if (status)
7812c78c	254	*status = (result < 0 ? -1 : 0);
dcdc26df DF	255	}
	256
	257
0dce3ca1 FXC	258
	259	/* FTELL intrinsic */
	260
b879c108 JB	261	static gfc_offset
	262	gf_ftell (int unit)
	263	{
	264	gfc_unit * u = find_unit (unit);
	265	if (u == NULL)
	266	return -1;
	267	int pos = fbuf_reset (u);
	268	if (pos != 0)
	269	sseek (u->s, pos, SEEK_CUR);
	270	gfc_offset ret = stell (u->s);
	271	unlock_unit (u);
	272	return ret;
	273	}
	274
0dce3ca1 FXC	275	extern size_t PREFIX(ftell) (int *);
	276	export_proto_np(PREFIX(ftell));
	277
	278	size_t
	279	PREFIX(ftell) (int * unit)
	280	{
b879c108	281	return gf_ftell (*unit);
0dce3ca1 FXC	282	}
	283
	284	#define FTELL_SUB(kind) \
	285	extern void ftell_i ## kind ## _sub (int , GFC_INTEGER_ ## kind ); \
	286	export_proto(ftell_i ## kind ## _sub); \
	287	void \
	288	ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \
	289	{ \
b879c108	290	offset = gf_ftell (unit); \
0dce3ca1 FXC	291	}
	292
	293	FTELL_SUB(1)
	294	FTELL_SUB(2)
	295	FTELL_SUB(4)
	296	FTELL_SUB(8)
	297
	298
	299
	300	/* LOGICAL FUNCTION ISATTY(UNIT)
	301	INTEGER, INTENT(IN) :: UNIT */
	302
	303	extern GFC_LOGICAL_4 isatty_l4 (int *);
	304	export_proto(isatty_l4);
	305
	306	GFC_LOGICAL_4
	307	isatty_l4 (int *unit)
	308	{
	309	gfc_unit *u;
	310	GFC_LOGICAL_4 ret = 0;
	311
	312	u = find_unit (*unit);
	313	if (u != NULL)
	314	{
	315	ret = (GFC_LOGICAL_4) stream_isatty (u->s);
	316	unlock_unit (u);
	317	}
	318	return ret;
	319	}
	320
	321
	322	extern GFC_LOGICAL_8 isatty_l8 (int *);
	323	export_proto(isatty_l8);
	324
	325	GFC_LOGICAL_8
	326	isatty_l8 (int *unit)
	327	{
	328	gfc_unit *u;
	329	GFC_LOGICAL_8 ret = 0;
	330
	331	u = find_unit (*unit);
	332	if (u != NULL)
	333	{
	334	ret = (GFC_LOGICAL_8) stream_isatty (u->s);
	335	unlock_unit (u);
	336	}
	337	return ret;
	338	}
	339
	340
	341	/* SUBROUTINE TTYNAM(UNIT,NAME)
	342	INTEGER,SCALAR,INTENT(IN) :: UNIT
	343	CHARACTER,SCALAR,INTENT(OUT) :: NAME */
	344
	345	extern void ttynam_sub (int , char , gfc_charlen_type);
	346	export_proto(ttynam_sub);
	347
	348	void
	349	ttynam_sub (int unit, char name, gfc_charlen_type name_len)
	350	{
	351	gfc_unit *u;
6a0f6e77 JB	352	int nlen;
6a0f6e77 JB	353	int err = 1;
0dce3ca1	354
0dce3ca1 FXC	355	u = find_unit (*unit);
	356	if (u != NULL)
	357	{
6a0f6e77 JB	358	err = stream_ttyname (u->s, name, name_len);
6a0f6e77 JB	359	if (err == 0)
0dce3ca1	360	{
6a0f6e77 JB	361	nlen = strlen (name);
6a0f6e77 JB	362	memset (&name[nlen], ' ', name_len - nlen);
0dce3ca1	363	}
6a0f6e77	364
0dce3ca1 FXC	365	unlock_unit (u);
0dce3ca1 FXC	366	}
6a0f6e77 JB	367	if (err != 0)
6a0f6e77 JB	368	memset (name, ' ', name_len);
0dce3ca1 FXC	369	}
	370
	371
	372	extern void ttynam (char *, gfc_charlen_type , int);
	373	export_proto(ttynam);
	374
	375	void
	376	ttynam (char ** name, gfc_charlen_type * name_len, int unit)
	377	{
	378	gfc_unit *u;
	379
	380	u = find_unit (unit);
	381	if (u != NULL)
	382	{
6a0f6e77 JB	383	*name = get_mem (TTY_NAME_MAX);
	384	int err = stream_ttyname (u->s, *name, TTY_NAME_MAX);
	385	if (err == 0)
0dce3ca1 FXC	386	{
0dce3ca1 FXC	387	name_len = strlen (name);
0dce3ca1 FXC	388	unlock_unit (u);
	389	return;
	390	}
6a0f6e77	391	free (*name);
0dce3ca1 FXC	392	unlock_unit (u);
	393	}
	394
	395	*name_len = 0;
	396	*name = NULL;
	397	}