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

/* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH 
   FTELL, TTYNAM and ISATTY intrinsics.
   Copyright (C) 2005-2021 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 <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 GFC_IO_INT PREFIX(ftell) (int *);
export_proto_np(PREFIX(ftell));

GFC_IO_INT
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 = xmalloc (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.
99dee823	3	Copyright (C) 2005-2021 Free Software Foundation, Inc.
5d723e54	4
e76a3fde	5	This file is part of the GNU Fortran runtime library (libgfortran).
5d723e54 FXC	6
	7	Libgfortran is free software; you can redistribute it and/or
	8	modify it under the terms of the GNU General Public
	9	License as published by the Free Software Foundation; either
748086b7	10	version 3 of the License, or (at your option) any later version.
5d723e54 FXC	11
	12	Libgfortran is distributed in the hope that it will be useful,
	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	GNU General Public License for more details.
	16
748086b7 JJ	17	Under Section 7 of GPL version 3, you are granted additional
	18	permissions described in the GCC Runtime Library Exception, version
	19	3.1, as published by the Free Software Foundation.
	20
	21	You should have received a copy of the GNU General Public License and
	22	a copy of the GCC Runtime Library Exception along with this program;
	23	see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
	24	<http://www.gnu.org/licenses/>. */
5d723e54	25
36ae8a61	26	#include "io.h"
92cbdb68 JB	27	#include "fbuf.h"
92cbdb68 JB	28	#include "unix.h"
5d723e54 FXC	29	#include <string.h>
5d723e54 FXC	30
74544378	31
5d723e54 FXC	32	static const int five = 5;
	33	static const int six = 6;
	34
	35	extern int PREFIX(fgetc) (const int , char , gfc_charlen_type);
	36	export_proto_np(PREFIX(fgetc));
	37
	38	int
f29876bb	39	PREFIX(fgetc) (const int unit, char c, gfc_charlen_type c_len)
5d723e54 FXC	40	{
5d723e54 FXC	41	int ret;
f29876bb	42	gfc_unit u = find_unit (unit);
5d723e54 FXC	43
	44	if (u == NULL)
	45	return -1;
	46
ee56ac9d JB	47	fbuf_reset (u);
	48	if (u->mode == WRITING)
	49	{
	50	sflush (u->s);
	51	u->mode = READING;
	52	}
	53
5d723e54	54	memset (c, ' ', c_len);
f9bfed22	55	ret = sread (u->s, c, 1);
401cd90a	56	unlock_unit (u);
5d723e54	57
7812c78c	58	if (ret < 0)
5d723e54 FXC	59	return ret;
5d723e54 FXC	60
7812c78c	61	if (ret != 1)
5d723e54 FXC	62	return -1;
	63	else
	64	return 0;
	65	}
	66
	67
	68	#define FGETC_SUB(kind) \
	69	extern void fgetc_i ## kind ## _sub \
	70	(const int , char , GFC_INTEGER_ ## kind *, gfc_charlen_type); \
	71	export_proto(fgetc_i ## kind ## _sub); \
	72	void fgetc_i ## kind ## _sub \
f29876bb	73	(const int unit, char c, GFC_INTEGER_ ## kind *st, gfc_charlen_type c_len) \
5d723e54 FXC	74	{ if (st != NULL) \
	75	*st = PREFIX(fgetc) (unit, c, c_len); \
	76	else \
	77	PREFIX(fgetc) (unit, c, c_len); }
	78
	79	FGETC_SUB(1)
	80	FGETC_SUB(2)
	81	FGETC_SUB(4)
	82	FGETC_SUB(8)
	83
	84
	85	extern int PREFIX(fget) (char *, gfc_charlen_type);
	86	export_proto_np(PREFIX(fget));
	87
	88	int
f29876bb	89	PREFIX(fget) (char *c, gfc_charlen_type c_len)
5d723e54 FXC	90	{
	91	return PREFIX(fgetc) (&five, c, c_len);
	92	}
	93
	94
	95	#define FGET_SUB(kind) \
	96	extern void fget_i ## kind ## _sub \
	97	(char , GFC_INTEGER_ ## kind , gfc_charlen_type); \
	98	export_proto(fget_i ## kind ## _sub); \
	99	void fget_i ## kind ## _sub \
f29876bb	100	(char c, GFC_INTEGER_ ## kind st, gfc_charlen_type c_len) \
5d723e54 FXC	101	{ if (st != NULL) \
	102	*st = PREFIX(fgetc) (&five, c, c_len); \
	103	else \
	104	PREFIX(fgetc) (&five, c, c_len); }
	105
	106	FGET_SUB(1)
	107	FGET_SUB(2)
	108	FGET_SUB(4)
	109	FGET_SUB(8)
	110
	111
	112
	113	extern int PREFIX(fputc) (const int , char , gfc_charlen_type);
	114	export_proto_np(PREFIX(fputc));
	115
	116	int
f29876bb	117	PREFIX(fputc) (const int unit, char c,
5d723e54 FXC	118	gfc_charlen_type c_len __attribute__((unused)))
5d723e54 FXC	119	{
7812c78c	120	ssize_t s;
f29876bb	121	gfc_unit u = find_unit (unit);
5d723e54 FXC	122
	123	if (u == NULL)
	124	return -1;
	125
ee56ac9d JB	126	fbuf_reset (u);
	127	if (u->mode == READING)
	128	{
	129	sflush (u->s);
	130	u->mode = WRITING;
	131	}
	132
7812c78c	133	s = swrite (u->s, c, 1);
401cd90a	134	unlock_unit (u);
7812c78c JD	135	if (s < 0)
	136	return -1;
	137	return 0;
5d723e54 FXC	138	}
	139
	140
	141	#define FPUTC_SUB(kind) \
	142	extern void fputc_i ## kind ## _sub \
	143	(const int , char , GFC_INTEGER_ ## kind *, gfc_charlen_type); \
	144	export_proto(fputc_i ## kind ## _sub); \
	145	void fputc_i ## kind ## _sub \
f29876bb	146	(const int unit, char c, GFC_INTEGER_ ## kind *st, gfc_charlen_type c_len) \
5d723e54 FXC	147	{ if (st != NULL) \
	148	*st = PREFIX(fputc) (unit, c, c_len); \
	149	else \
	150	PREFIX(fputc) (unit, c, c_len); }
	151
	152	FPUTC_SUB(1)
	153	FPUTC_SUB(2)
	154	FPUTC_SUB(4)
	155	FPUTC_SUB(8)
	156
	157
	158	extern int PREFIX(fput) (char *, gfc_charlen_type);
	159	export_proto_np(PREFIX(fput));
	160
	161	int
f29876bb	162	PREFIX(fput) (char *c, gfc_charlen_type c_len)
5d723e54 FXC	163	{
	164	return PREFIX(fputc) (&six, c, c_len);
	165	}
	166
	167
	168	#define FPUT_SUB(kind) \
	169	extern void fput_i ## kind ## _sub \
	170	(char , GFC_INTEGER_ ## kind , gfc_charlen_type); \
	171	export_proto(fput_i ## kind ## _sub); \
	172	void fput_i ## kind ## _sub \
f29876bb	173	(char c, GFC_INTEGER_ ## kind st, gfc_charlen_type c_len) \
5d723e54 FXC	174	{ if (st != NULL) \
	175	*st = PREFIX(fputc) (&six, c, c_len); \
	176	else \
	177	PREFIX(fputc) (&six, c, c_len); }
	178
	179	FPUT_SUB(1)
	180	FPUT_SUB(2)
	181	FPUT_SUB(4)
	182	FPUT_SUB(8)
	183
0dce3ca1 FXC	184
	185	/* SUBROUTINE FLUSH(UNIT)
	186	INTEGER, INTENT(IN), OPTIONAL :: UNIT */
	187
	188	extern void flush_i4 (GFC_INTEGER_4 *);
	189	export_proto(flush_i4);
	190
	191	void
	192	flush_i4 (GFC_INTEGER_4 *unit)
	193	{
	194	gfc_unit *us;
	195
	196	/* flush all streams */
	197	if (unit == NULL)
	198	flush_all_units ();
	199	else
	200	{
	201	us = find_unit (*unit);
	202	if (us != NULL)
	203	{
7812c78c	204	sflush (us->s);
0dce3ca1 FXC	205	unlock_unit (us);
	206	}
	207	}
	208	}
	209
	210
	211	extern void flush_i8 (GFC_INTEGER_8 *);
	212	export_proto(flush_i8);
	213
	214	void
	215	flush_i8 (GFC_INTEGER_8 *unit)
	216	{
	217	gfc_unit *us;
	218
	219	/* flush all streams */
	220	if (unit == NULL)
	221	flush_all_units ();
	222	else
	223	{
	224	us = find_unit (*unit);
	225	if (us != NULL)
	226	{
7812c78c	227	sflush (us->s);
0dce3ca1 FXC	228	unlock_unit (us);
	229	}
	230	}
	231	}
	232
dcdc26df DF	233	/* FSEEK intrinsic */
	234
	235	extern void fseek_sub (int , GFC_IO_INT , int , int );
	236	export_proto(fseek_sub);
	237
	238	void
f29876bb	239	fseek_sub (int unit, GFC_IO_INT offset, int whence, int status)
dcdc26df	240	{
f29876bb	241	gfc_unit u = find_unit (unit);
7812c78c	242	ssize_t result = -1;
dcdc26df	243
7d5ee219	244	if (u != NULL)
dcdc26df	245	{
7812c78c	246	result = sseek(u->s, offset, whence);
dcdc26df DF	247
	248	unlock_unit (u);
	249	}
	250
	251	if (status)
7812c78c	252	*status = (result < 0 ? -1 : 0);
dcdc26df DF	253	}
	254
	255
0dce3ca1 FXC	256
	257	/* FTELL intrinsic */
	258
b879c108 JB	259	static gfc_offset
	260	gf_ftell (int unit)
	261	{
f29876bb	262	gfc_unit *u = find_unit (unit);
b879c108 JB	263	if (u == NULL)
	264	return -1;
	265	int pos = fbuf_reset (u);
	266	if (pos != 0)
	267	sseek (u->s, pos, SEEK_CUR);
	268	gfc_offset ret = stell (u->s);
	269	unlock_unit (u);
	270	return ret;
	271	}
	272
67eb28c8	273
f7db9ebf	274	extern GFC_IO_INT PREFIX(ftell) (int *);
0dce3ca1 FXC	275	export_proto_np(PREFIX(ftell));
0dce3ca1 FXC	276
67eb28c8	277	GFC_IO_INT
f29876bb	278	PREFIX(ftell) (int *unit)
67eb28c8 JB	279	{
	280	return gf_ftell (*unit);
	281	}
	282
	283
0dce3ca1 FXC	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 \
f29876bb	288	ftell_i ## kind ## _sub (int unit, GFC_INTEGER_ ## kind offset) \
0dce3ca1	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
f29876bb	349	ttynam_sub (int unit, char name, gfc_charlen_type name_len)
0dce3ca1 FXC	350	{
0dce3ca1 FXC	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
f29876bb	376	ttynam (char *name, gfc_charlen_type name_len, int unit)
0dce3ca1 FXC	377	{
	378	gfc_unit *u;
	379
	380	u = find_unit (unit);
	381	if (u != NULL)
	382	{
1a0fd3d3	383	*name = xmalloc (TTY_NAME_MAX);
6a0f6e77 JB	384	int err = stream_ttyname (u->s, *name, TTY_NAME_MAX);
6a0f6e77 JB	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	}