/************************************************************************
 * This program is Copyright (C) 1986 by Jonathan Payne.  JOVE is	*
 * provided to you without charge, and with no warranty.  You may give	*
 * away copies of JOVE, including sources, provided that this notice is *
 * included in all the files.						*
 ************************************************************************/
/*
 * VMS-specific stuff for JOVE.
 */

#include "tune.h"

RCS("$Id: vms.c,v 14.32 1993/06/14 23:35:12 tom Exp tom $")

#if vms	/* the rest of this file */

#include <descrip.h>
#include <ssdef.h>
#include <stsdef.h>
#include <rmsdef.h>
#ifdef READDIR_IMPLEMENTATION		/* included by NON_JOVE "readdir.h" */
#   include <ctype.h>
#else
#include <clidef.h>
#include <dcdef.h>
#include <dvidef.h>
#include <iodef.h>
#include <msgdef.h>
#include <ttdef.h>
#include <tt2def.h>

#include "jove.h"
#include "ctype.h"
#include "io.h"
#include "process.h"
#include "readdir.h"
#include "termcap.h"
#include "tty.h"
#endif

#define STRDESCRIPTOR(desc, strptr) struct dsc$descriptor desc = \
	{strlen(strptr), DSC$K_DTYPE_T, DSC$K_CLASS_S, strptr}

#ifndef READDIR_IMPLEMENTATION	/* if defined, only {open,read,close}dir */

#ifdef VAXC
/* VAX C claims it implements `raise' but it is not present in the shareable
   image library.  So use `gsignal' instead... */
#   define raise	gsignal
#endif

char	*vms2ux __(( char *_(dest), const char *_(src) )),
	*ux2vms __(( char *_(dest), const char *_(src) ));

void
vms_error_message(message, status)
const char	*message;
int		status;
{
	f_mess("[%s: %s]", message, strerror(EVMSERR, status));
}

void
handle_vms_error(message, status)
const char	*message;
int		status;
{
	vms_error_message(message, status);
	if (!$VMS_STATUS_SUCCESS(status) &&
	    (status & (STS$K_ERROR|STS$K_SEVERE)))
		finish(status);
}

/* convert process (mailbox) output to a neat C-string:
   ignore null characters and carriage-returns; append a newline. */

char *
vms_normalize_string(dest, src, size)
char		*dest;
const char	*src;
size_t		size;
{
	register char		*d = dest;
	register const char	*s = src,
				*end = s + size;

	while (s < end) {
		if ((*d = *s++) == '\0' || *d == '\r')
			continue;
		d++;
	}
	if (d == dest || d[-1] != '\n')
		*d++ = '\n';
	*d++ = '\0';

	return dest;
}

/*======================================================================*/
/*				  TTY.C					*/
/*======================================================================*/

#ifndef CSPEED
#   define CSPEED	960
#endif

static const int speeds[] = {
	CSPEED,	5,	7,	11,	13,	15,	30,	60,
	120,	180,	200,	240,	360,	480,	720,	960,
	1920,	3840, /* extra for future extensions */	CSPEED,	CSPEED
};
#define SPEED(ospeed)	speeds[ospeed]

struct iosb {				/* I/O status block		*/
	unsigned short	i_status;		/* condition code	*/
	unsigned short	i_count;
	unsigned short	i_terminator;
	unsigned short	i_termsize;
};

struct termchar {			/* Terminal characteristics	*/
	char		t_class;
	char		t_type;
	unsigned short	t_width;		/* width in characters	*/
	unsigned	t_mode : 24;		/* flags		*/
	unsigned	t_page : 8;		/* page size in lines	*/
	unsigned long	t_xmode;		/* more flags		*/
};

#define SGTTYB	struct termchar

#define sg	_sg	/* `sg' conflicts with `SG' */

SGTTYB	sg[2];

private short	ttraw;

/*
   VMS Asynchronous keyboard input:

   all this crap is necessary since the VMS terminal driver offers very
   little choice between `cooked' and `raw' mode, and we still want
   the interrupt character to work.

   How it works:

   Basically it's the classical producer/consumer situation, with the
   keyboard reading AST-process as the producer, and the regular
   rawchar routine as the consumer.  Characters are buffered in a fifo
   queue. The queue is empty when (get_ptr == put_ptr), and full when
   (next(put_ptr) == get_ptr). In that case the keyboard process is
   suspended.  It is explicitly resumed by rawchar when the buffer is
   empty.
 */

#define KBDQSIZE	64

private struct kbd_queue {
	/* the keyboard queue proper. */
	char		*put_ptr;
	char		*get_ptr;
	char		buffer[KBDQSIZE];
	/* status flags. */
	char		waiting,	/* waiting for input.		*/
			suspended;	/* keyboard AST suspended.	*/
	/* VMS-specific AST stuff. */
	long		term[2];	/* character terminator mask.	*/
	struct iosb	iosb;		/* I/O completion status.	*/
	short		chan;		/* I/O channel assigned to kbd.	*/
	int		input_ef;	/* input completion event flag	*/
} kbdq ZERO;

#define empty_queue(kq)	((kq)->put_ptr == (kq)->get_ptr)

enum { KBD_EF=1, TIMER_EF, PROCESS_EF };	/* event flags		*/

#ifdef IPROCS
public int	process_ef = PROCESS_EF;	/* for ipr-vms.inc	*/
#endif

#define ttchan	kbdq.chan		/* a convenient alias.		*/

#ifdef MAIL
private short	ttmbx;			/* associated mailbox I/O channel */
private int	ttmbx_size;		/* message size of associated mbx */

private void	establish_mbx_handler __(( void (*_(handler))(void) )),
		broadcast_handler __(( void ));
#else
DEF_INT( "disable-broadcast-messages", NoBroadcast, V_BOOL ) ZERO; _IF( vms)_IF(ndef MAIL)_IF(def PRIVATE)
#endif

private void
kbd_init()
{
	if (!ttchan) {
		static $DESCRIPTOR(sys_input, "SYS$INPUT:");
		register int	st;
#ifdef MAIL
		/* Initialize terminal channel with associated mailbox
		   to catch broadcast messages.  If this fails, retry to open
		   just the terminal channel, and forget about the mailbox. */

		st = lib$asn_wth_mbx(&sys_input, 0, 0, &ttchan, &ttmbx);

		if ($VMS_STATUS_SUCCESS(st)) {
			if (!$VMS_STATUS_SUCCESS(lib$getdvi(&DVI$_DEVBUFSIZ,
							    &ttmbx, 0,
							    &ttmbx_size))) {
				sys$dassgn(ttmbx);
				ttmbx = 0;
			}
			else
				establish_mbx_handler(broadcast_handler);
		}
		else /* the next sys$assign statement */
#endif
			st = sys$assign(&sys_input, &ttchan, 0, 0);

		if (!$VMS_STATUS_SUCCESS(st))
			/* These are fatal errors, my friend... */
			_exit(st);

		kbdq.input_ef = KBD_EF;
		kbdq.get_ptr = kbdq.put_ptr = kbdq.buffer;
		kbdq.suspended = YES;
		kbdq.term[1] = (1L << IntChar);
	}
}

private void
kbd_exit()
{
	kbd(OFF);
	sys$dassgn(ttchan);
	ttchan = 0;
#ifdef MAIL
	establish_mbx_handler(NULL);
	sys$dassgn(ttmbx);
	ttmbx = 0;
#endif
}

extern int	done_ttinit;
void
ttinit()
{
	do_sgtty();
	if (!done_ttinit) {				/* once-only */
		if (sg[OFF].t_mode & TT$M_EIGHTBIT)
			MetaKey = ESC;
	}
	done_ttinit = 1;
}

void
ttexit()
{
	kbd_exit();
}

void
do_sgtty()
{
	register int	st;
	struct iosb	iosb;

	kbd_init();

	/* get terminal characteristics */
	if (!$VMS_STATUS_SUCCESS(st = sys$qiow(0, ttchan, IO$_SENSEMODE, &iosb,
					       0,0, &sg[OFF], sizeof sg[OFF],
					       0,0,0,0)) ||
	    !$VMS_STATUS_SUCCESS(st = iosb.i_status))
		_exit(st);

	/* check that it's a terminal all right (this shouldn't happen). */
	if (sg[OFF].t_class != DC$_TERM) {
		printf("\7\r\"sys$input:\" is not a terminal\r\n");
		finish(1);
	}
	sg[ON] = sg[OFF];
	ospeed = _UC_(iosb.i_count);
#ifdef CURSOPT
	TABS = (sg[OFF].t_mode & TT$M_MECHTAB);
#endif
	if (True(OKXonXoff))
		sg[ON].t_mode &= ~(TT$M_TTSYNC);
	if (MetaKey)
		sg[ON].t_mode |= TT$M_EIGHTBIT;
	sg[ON].t_xmode |= TT2$M_PASTHRU;
#ifdef MAIL
	/* Enable mailboxing broadcasts only if we could access the mailbox. */
	if (ttmbx) {
		/* No ``unsolicited input/hangup'' messages to mailbox,
		   no Broadcast directly to the terminal. */
		sg[ON].t_mode |= TT$M_MBXDSABL|TT$M_NOBRDCST;
		/* Send Broadcasts to the mailbox instead. */
		sg[ON].t_xmode |= TT2$M_BRDCSTMBX;
	}
#else
	if (True(NoBroadcast))
		sg[ON].t_mode |= TT$M_NOBRDCST;
#endif
	CharsPerSec = SPEED(ospeed);

	/* this is to disable padding when we're using Xon/Xoff flow control. */
	if (False(OKXonXoff))
		ospeed = 0;

	/* set interrupt character. */
	kbdq.term[1] = (0 < IntChar && IntChar < ' ') ? (1L << IntChar) : 0;
}

void
ttyset(on)
{
	if (!done_ttinit)
		return;

	/* For some reason keyboard input AST should be canceled BEFORE
	   changing terminal modes, or else it does not cancel
	   immediately. (we don't have to turn it back on explicitly since
	   input is resumed as soon as the input queue is empty) */
	if (!on)
		kbd(OFF);

	sys$qiow(0, ttchan, IO$_SETMODE, 0,0,0,
		 &sg[on], sizeof sg[on], 0,0,0,0);
	flusho();
	if (!(ttraw = on)) {
		/* This is turned off in UnsetTerm; turn it back on if
		   necessary. */
		if (sg[OFF].t_xmode & TT2$M_APP_KEYPAD)
			putp(KS);
	}
}

void
ttsize()
{
	struct iosb	iosb;
	SGTTYB		tc;

	kbd_init();

	if ($VMS_STATUS_SUCCESS(sys$qiow(0, ttchan, IO$_SENSEMODE, &iosb, 0,0,
					 &tc, sizeof tc, 0,0,0,0)) &&
	    $VMS_STATUS_SUCCESS(iosb.i_status) &&
	    (tc.t_width > 0) &&
	    (tc.t_page > 0)) {
		LI = tc.t_page;
		CO = tc.t_width;
		if (CO > MAXCOLS)
			CO = MAXCOLS;
#ifdef VARTERM
	    {	extern short	newdim[2];
		register int	c, l;

		if (c = newdim[0]) {
			newdim[0] = 0;
			sg[OFF].t_width = sg[ON].t_width = tc.t_width = c;
			if (c > MAXCOLS)
				c = MAXCOLS;
			CO = c;
		}
		if (l = newdim[1]) {
			newdim[1] = 0;
			sg[OFF].t_page = sg[ON].t_page = tc.t_page = LI = l;
		}
		if (c || l) {		/* make it known to terminal driver */
			kbd(OFF);	/* {see ttyset for explanation} */
			sys$qiow(0, ttchan, IO$_SETMODE, 0, 0,0,
				 &tc, sizeof tc, 0,0,0,0);
		}
	    }
#endif
	}
	ILI =  LI - 1;
}

DoSit(delay)
{
	while (--delay > 0) {
		static long	sleep_time[2] = { -10*1000*100L, -1 };

		if ($VMS_STATUS_SUCCESS(sys$schdwk(0, 0, sleep_time, 0)))
			sys$hiber();

		if (InputPending = charp())
			return YES;
	}
	return NO;
}

/* This routine constitutes the actual asynchronous keyboard input process.
   It is an AST invoked at completion of the QIO requesting input from the
   tty, and (unless suspended) issues a new keyboard read request. */

private void
kbd_input_ast(kq)
register struct kbd_queue *kq;
{
	private int	kbd_restart __(( struct kbd_queue *_(kq) ));
	register int	st = kq->iosb.i_status;

	kq->suspended = YES;

	if (!$VMS_STATUS_SUCCESS(st)) {	/* check I/O completion status */
		if (st == SS$_ABORT)	/* i.e., $cancel()ed */
			return;
		handle_vms_error("kbd read", st);
		kq->suspended = NO;
	}
	else if (kq->iosb.i_termsize) {	/* it's our interrupt character! */
		raise(SIGINT);
		kq->suspended = NO;
	}
	else {
		register char	*adv_ptr = kq->put_ptr;

		if (++adv_ptr == &kq->buffer[sizeof kq->buffer])
			adv_ptr -= sizeof kq->buffer;	/* wraparound */

		if (adv_ptr != kq->get_ptr) {		/* buffer not full? */
			kq->put_ptr = adv_ptr;
			/* set event flag if we are waited for. */
			if (kq->waiting &&
			    !$VMS_STATUS_SUCCESS(st = sys$setef(kq->input_ef)))
				handle_vms_error("kbd setef", st);
			kq->suspended = NO;
		}
	}
	if (!kq->suspended)
		kbd_restart(kq);
}

/* (re)start keyboard process. */

private int
kbd_restart(kq)
register struct kbd_queue *kq;
{
	register int	st;

	kq->suspended = NO;
	st = sys$qio(0, kq->chan, IO$_READVBLK|IO$M_NOECHO, &kq->iosb,
		     kbd_input_ast, kq, kq->put_ptr, 1, 0, kq->term, 0,0);

	if (!$VMS_STATUS_SUCCESS(st)) {
		kq->suspended = YES;
		handle_vms_error("kbd restart", st);
	}
	return $VMS_STATUS_SUCCESS(st);
}

/* Suspend keyboard process. */

private int
kbd_suspend(kq)
register struct kbd_queue *kq;
{
	register int	st;

	kq->suspended = YES;

	if (!$VMS_STATUS_SUCCESS(st = sys$cancel(kq->chan)))
		handle_vms_error("kbd suspend", st);

	return $VMS_STATUS_SUCCESS(st);
}

public int
kbd(on)
{
	int	suspended = kbdq.suspended;

	if (!(on ^ suspended)) {	/* state change requested */
		if (on)
			kbd_restart(&kbdq);
		else
			kbd_suspend(&kbdq);
		on ^= YES;
	}
	return on;
}

/* Now this is very simple indeed... */

public int
charp()
{
	if (inIOread)
		return NO;
	if (InJoverc || !empty_queue(&kbdq))
		return YES;
	return NO;
}

#ifndef MSEC_TIMEOUT
#   define MSEC_TIMEOUT	350
#endif

public int
#ifdef FUNCKEYS
rawchar(time_out)
#else
getchar()
#   define time_out NO
#endif /* FUNCKEYS */
{
	register int	c;
	extern void	(*timeout_proc)__(( void ));

#define handle_timeout() do {			\
		if (timeout_proc)		\
			(*timeout_proc)();	\
	} while (0)

#ifndef time_out
#   undef handle_timeout /* ...and redefine this to handle time_out requests */
#   define handle_timeout() do {		\
		if (timeout_proc)		\
			(*timeout_proc)();	\
		if (time_out)			\
			return -1;		\
	} while (0)
#endif

	while (empty_queue(&kbdq)) {
		register int	st;

		/* restart kbd process if it is suspended. */
		if (kbdq.suspended)
			if (!kbd_restart(&kbdq))
				continue;

		/* clear event flag, THEN notify AST we're waiting for input. */
		if (!$VMS_STATUS_SUCCESS(st = sys$clref(KBD_EF)))
			handle_vms_error("rawchar clref", st);

		kbdq.waiting = YES;

		/* check again, since kbd process may have delivered a char.
		   between the last check and the setting of the wait flag. */

		if (empty_queue(&kbdq)) {
			static long timout[] = { -10*1000*MSEC_TIMEOUT, -1 },
				one_second[] = { -10*1000*1000, -1 };
			long	ef_mask = (1L << KBD_EF | 1L << PROCESS_EF);

			if (time_out || timeout_proc) {
				ef_mask |= (1L << TIMER_EF);

				st = sys$setimr(TIMER_EF, time_out ?
						timout : one_second, 0, 42);
				if (!$VMS_STATUS_SUCCESS(st))
					handle_vms_error("rawchar setimr", st);
			}

			st = sys$wflor(TIMER_EF, ef_mask);
			if (!$VMS_STATUS_SUCCESS(st))
				handle_vms_error("rawchar wflor", st);
			st = sys$readef(TIMER_EF, &ef_mask);
			if (!$VMS_STATUS_SUCCESS(st))
				handle_vms_error("rawchar readef", st);
#ifdef IPROCS
			/* process input only needs to be re-started */
			if (ef_mask & (1L << PROCESS_EF))
				restart_process_input();
#endif
			if (ef_mask & (1L << TIMER_EF)) {
				/* handle-timeout could return,
				   so turn off wait flag. */
				kbdq.waiting = NO;
				handle_timeout();
				continue;
			}
			if (time_out || timeout_proc)
				/* no time-out, so cancel timer. */
				sys$cantim(42, 0);
		}
		kbdq.waiting = NO;
	}

	c = *kbdq.get_ptr;
#ifndef FUNCKEYS
	if (c & 0200) {
		if (MetaKey) {
			*kbdq.get_ptr = c &= 0177;
			return MetaKey;
		}
		else {
			static short SendQuote ZERO;
			if (SendQuote ^= YES)
				return QuoteChar;
		}
	}
#endif
	/* advance read pointer */
	if (kbdq.get_ptr == &kbdq.buffer[sizeof kbdq.buffer - 1])
		kbdq.get_ptr = kbdq.buffer;
	else
		++kbdq.get_ptr;

	return _UC_(c);
}

/* read a single character from stdin, assuming kbd is OFF. */
void
read_one_char(cp)
char	*cp;
{
	sys$qiow(0, ttchan, IO$_READVBLK|IO$M_NOECHO, 0,0,0, cp, 1, 0,0,0,0);
}

#ifdef MAIL
/* This handles broadcast messages.
   All VMS-specifics are in `establish_mbx_handler' and `get_broadcast_message'
 */

private void
establish_mbx_handler(handler)
void	(handler)__(( void ));
{
	sys$qiow(0, ttmbx, IO$_SETMODE|IO$M_WRTATTN, 0,0,0,
		 handler, 0, 3 /* user mode */, 0,0,0);
}

private char *
get_broadcast_message(buf)
char	buf[BUFSIZ];
{
	struct iosb	iosb;
	struct {
		unsigned short	m_type;
		unsigned short	m_unit;
		unsigned char	m_devnamlength;
		char		m_devnam[15];
		unsigned short	m_length;
		char		m_body[BUFSIZ];
	} msg;

	if (ttmbx_size > sizeof msg - 1)
		ttmbx_size = sizeof msg - 1;

	/* Fetch the message, and check that we indeed got one (someone else
	   could have snatched it), ignore non-broadcast messages, and
	   return the message found in `buf'. */

	for (;;) {
		if ($VMS_STATUS_SUCCESS(sys$qiow(0, ttmbx,
						 IO$_READVBLK|IO$M_NOW, &iosb,
						 0,0, &msg, ttmbx_size,
						 0,0,0,0)) &&
		    (iosb.i_status == SS$_NORMAL ||
		     iosb.i_status == SS$_BUFFEROVF) &&
		    (iosb.i_count >= sizeof msg - sizeof msg.m_body)) {

			/* ignore non-broadcast messages */
			if (msg.m_type != MSG$_TRMBRDCST)
				continue;

			/* truncate the message */
			if (msg.m_length >= sizeof msg.m_body)
				msg.m_length = sizeof msg.m_body - 1;

			/* normalize the message; skip leading control chars. */
			vms_normalize_string(buf, msg.m_body, msg.m_length);
			while (isctrl(*buf) && *buf != '\0' && *buf != '\t')
				buf++;

			return buf;
		}
		break;
	}
	return NULL;
}

/* All JOVE-specific broadcast message handling goes here:
   Show the message on the message line if we're not Asking, ring the bell,
   remember the time we received the broadcast (for chkmail, which is now
   a misnomer), append the message to the buffer *message*,
   and redisplay if we can safely do that. */

private time_t	last_broadcast_seen ZERO;

private void
broadcast_handler()
{
	Buffer		*orgbuf = curbuf;
	register Buffer	*msgbuf;
	char		buf[BUFSIZ];
	register char	*message;

	if (message = get_broadcast_message(buf)) {

		time(&last_broadcast_seen);
		dobell(3);
		if (inIOread && !Asking) {
			errormsg++;	/* so message lingers around... */
			s_mess("%s", message);
		}
		SetBuf(msgbuf = do_select((Window *) 0, "*message*"));
		SETBUFTYPE(msgbuf, B_SCRATCH);

		do {
			ToLast();
			if (!bolp(msgbuf))
				LineInsert(1);
			ins_str(message, YES);
		} while (message = get_broadcast_message(buf));

		SetBuf(orgbuf);

		updmodline();
		if (inIOread)
			redisplay();
	}
	establish_mbx_handler(broadcast_handler);
}

public int
chkmail(force)
{
	if (last_broadcast_seen) {
		if (!force &&
		    (time((time_t *) 0) < last_broadcast_seen + MailInt))
			return YES;

		last_broadcast_seen = 0;
	}
	return NO;
}
#endif /* MAIL */

/*======================================================================*/
/*				  PROC.C				*/
/*======================================================================*/

int
DEFVARG(UnixToBuf, (const char *bufname, int disp, int wsize,
		    int clobber, const char *infile, ...),
		   (bufname, disp, wsize, clobber, infile, va_alist)
	const char	*bufname;
	register int	disp;
	int		clobber;
	const char	*infile;)
{
	int	status;
	char	*cmd;
	va_list	ap;

	/* I'm being lazy here by assuming that UnixToBuf is either
	   invoked with "Shell, ShFlags, command" or just "command". */
	va_begin(ap, infile);
	if ((cmd = va_arg(ap, char *)) == Shell && va_arg(ap, char *) == ShFlags)
		cmd = va_arg(ap, char *);
	va_end(ap);

	if (clobber)
		isprocbuf(bufname);

	message("Starting up...");

	if (disp) {
#ifdef PROC_TYPEOUT
	    if (disp > 0) /* the next comma-separated statement */
#endif
		pop_wind(bufname, clobber, clobber ? B_PROCESS : B_FILE),
		set_wsize(wsize);
		redisplay();
	}
    {
	char	tmp[3][FILESIZE];

	if (infile == NULL)
		infile = DevNull;
	else
		infile = ux2vms(tmp[0], vms2ux(tmp[1], infile));
      {
	char	*pipe = (bufname == DevNull) ? DevNull :
		 ux2vms(tmp[1], vms2ux(tmp[2], mktmpe(tmp[1], "jpipeXXXXXX")));
	int	pipe_fd;
	STRDESCRIPTOR(cdsc, cmd);
	STRDESCRIPTOR(idsc, infile);
	STRDESCRIPTOR(odsc, pipe);

	if (lib$spawn(&cdsc, &idsc, &odsc, 0, 0, 0, &status) == SS$_NORMAL &&
	    (pipe_fd = open(pipe, O_RDONLY)) >= 0) {
		read_pipe(bufname, pipe_fd, disp);
		unlink(pipe);
	}
	else
		status = -ENOEXEC;
      }
    }
	return status;
}

/* Suspend JOVE and connect to parent shell, if any, else spawn a subshell */
private void
doPause(ppid)
{
	int st;
	static Signal sigs[] = {
		SIGINT,		SIG_DFL,
		SIGQUIT,	SIG_DFL
	};

	GetSigs(SigIntQuit, sizeof SigIntQuit/sizeof SigIntQuit[0]);
	UnsetTerm(ModBufs(0) ? "[There are modified buffers]" : (char *) 0);
	SetSigs(sigs, sizeof sigs/sizeof sigs[0]);

	kbd_exit();	/* close terminal + mbx channels so associated
			   mailbox does not get in the way. */

	st = (ppid && ppid != -1) ? lib$attach(&ppid) : lib$spawn();

	if (!$VMS_STATUS_SUCCESS(st))
		s_mess("[I cannot %f: %s]", strerror(EVMSERR, st));

	ResetTerm();
	SetSigs(SigIntQuit, sizeof SigIntQuit/sizeof SigIntQuit[0]);
	ClAndRedraw();
}

/* Suspend JOVE and revert to parent shell. */

DEF_CMD( "pause-jove", PauseJove, NO );  _IF( vms)
DEF_CMD( "suspend-jove", PauseJove, NO ) _IF( vms)
{
	doPause(getppid());
}

/* Spawn a sub-process shell. */
void
Push()
{
	doPause(0);
}

#endif /* !READDIR_IMPLEMENTATION */

/*======================================================================*/
/*				  IO.C					*/
/*======================================================================*/

/* convert a (possibly hybrid) VMS pathname to UNIX pathname.
  {this one is more tolerant than the VAXC routine SHELL$FROM_VMS} */

char *
vms2ux(uxname, vmsname)
char		*uxname;
const char	*vmsname;
{
	register unsigned char		*d = uxname;
	register const unsigned char	*s = vmsname;
	int				in_dir = 0;
	int				abspath = 0;
	register unsigned char		*lastdot = NULL;

	*d++ = '/';
	if (*s == '/')		/* absolute UNIX spec. */
		abspath = 1;

	while (*d = tolower(*s++)) {
		switch (*d) {
		case ':':
			if (in_dir || abspath > 0)
				return NULL;
			if (*s == ':') {	/* node name */
				register char	*t = uxname;

				if (abspath != 0)
					return NULL;
				s++;
				*d = '!';
				do t[0] = t[1]; while (++t < d);
				abspath = -1;
			}
			else {	/* we could try to translate this as a
				   logical name here, so as to get an
				   unambiguated file name (but we'd get in
				   trouble if logical name contains a
				   search path.) */
				abspath = 1;
			}

			*d++ = '/';
			break;

		case '[':		/* start directory */
		case '<':		/* (DECsystem 10/20 syntax) */

			/* allow chained (`[foo]bar/b.q[baz]'), but not
			   nested (`[foo.bar[b.q]baz]') dir.specs. */

			if (in_dir > 0)
				return NULL;

			/* insert current disk id. if dirspec is absolute
			   (i.e. does not start with `.' or `-')  and no disk
			   id. is yet present.  We have to do this since
			   relative UNIX paths are understood as relative
			   to the current DIRECTORY, not the current DRIVE. */

			if (!in_dir && !abspath && s[0] != '.' && s[0] != '-') {
				abspath = 1;
				d = appcpy(d, "sys$disk");
			}
			/* fortunately the distance between `[' and `]' is
			   the same as that between `<' and `>' (in ASCII) */

			in_dir = s[-1] - '[' + ']';

			if (d[-1] != '/')
				*d++ = '/';
			break;

		case '.':
			if (*s == *d) {
				if (d[-1] != '/')
					*d++ = '/', *d = '.';
				/* ".." parent directory */
				if (s[1] != *d)
					d++, *d++ = *s++, *d++ = '/';
				/* "..." wildcard needs special care */
				else if (s[2] == in_dir)
					d++, *d++ = *s++, *d++ = *s++;
			}
			else if (in_dir > 0) {
				if (d[-1] != '/')
					*d++ = '/';
			}
			else
				lastdot = d++;
			break;

		case '-':
			if (in_dir > 0 && d[-1] == '/' &&
			    (*s == '.' || *s == in_dir || *s == '/')) {
				*d++ = '.', *d = '.';
			}
			d++;
			break;


		case '/':			/* mixed vms<->unix */
			if (lastdot) {
				*lastdot = '/';
				lastdot = NULL;
			}
			if (d[-1] != '/') {
				*d++ = '/';
			}
			if (in_dir == 0)
				in_dir--;	/* we saw a subdirectory */
			break;

		default:
			if (*d == in_dir) {	/* end of dir. spec. */
				in_dir = -1;
				if (d[-1] != '/')
					*d++ = '/';
			}
			else
				d++;
			break;
		}
	}
	if (in_dir > 0) {		/* be friendly, append slash */
		if (d[-1] != '/')
			*d++ = '/', *d = '\0';
	}
	if (d[-1] == '.')		/* remove trailing dot. */
		d[-1] = '\0';
	if (!abspath)	/* relative path */
		strcpy(uxname, uxname + 1);

	return uxname;
}

/* convert a UNIX pathname to VMS pathname.
  {this could be replaced by the VAXC routine SHELL$TO_VMS} */

char *
ux2vms(vmsname, uxname)
char		*vmsname;
const char	*uxname;
{
	register char		*d = vmsname;
	register const char	*s = uxname;
	register char		*lastslash = NULL;
	int			abspath = 0;

	if (*s != '/') {	/* relative pathname, OR network name */
		if (index(s, '!') == index(s, '/') - 1) {
			while ((*d++ = *s++) != '!') ;
			d[-1] = ':', *d++ = ':';
		}
	}
	if (*s == '/') {		/* absolute pathname */
		abspath = 1;
		++s;
		while ((*d++ = *s++) != '/') ;
		d[-1] = ':';
	}
	if (index(s, '/') || strcmp(s, "..") == 0) {
		*d++ = '[';
		if (!abspath && *s != '.')
			*d++ = '.';
	}

	while (*d = *s++) {
		switch (*d) {
		case '/':
			if (d[-1] == '.')
				continue;
			lastslash = d;
			*d = '.';
			break;
		case '.':
			if (s[0] == '.') {
				/* "..." wildcard needs special care */
				if (s[1] == '.' && s[2] == '/')
					d++, *d++ = *s++, *d++ = *s++,
					s++, lastslash = d, *d = '.';
				/* ".." parent directory */
				else if (s[1] == '/' || s[1] == '\0')
					*d++ = '-',
					s++, lastslash = d, *d = '.';
			}
		}
		d++;
	}
	if (lastslash)
		*lastslash++ = ']';
	else
		lastslash = vmsname;

	/* add trailing '.' if necessary, to prevent default extensions. */
	if (d != lastslash && !index(lastslash, '.'))
		*d++ = '.', *d = '\0';

	return vmsname;
}

private int
get_next_dir_entry(dp)
register DIR	*dp;
{
	STRDESCRIPTOR(filespec, dp->d_vms_dirname);
	struct dsc$descriptor_vs resultspec = {
		sizeof(dp->d_next_entry.body)-1,
		DSC$K_DTYPE_VT, DSC$K_CLASS_VS, &dp->d_next_entry
	};
	static $DESCRIPTOR(defaultspec, "*.*");
	static $DESCRIPTOR(dirspec, "*.DIR");
	int	st;

	if ((st = lib$find_file(&filespec, &resultspec, &dp->d_context,
				(ask_dir_only >= 0) ? &dirspec :
					&defaultspec)) & STS$M_SUCCESS) {
		register char *cp;

		cp = &dp->d_next_entry.body[dp->d_next_entry.length];
		*cp = '\0';
		while (cp > dp->d_next_entry.body) {
			if (*--cp == ';') {	/* ignore version */
				*cp-- = '\0';
				break;
			}
		}
		if (*cp == '.')
			*cp = '\0';
		return 1;
	}
	dp->d_next_entry.length = 0;	/* directory exhausted */
	dp->d_next_entry.body[0] = '\0';

	return (st == RMS$_NMF) ? 0 : -1;
}

DIR *
opendir(dirname)
const char	*dirname;
{
	static DIR	theDIR;		/* support one open dir. at a time... */
	register DIR	*dp = &theDIR;
	char		tmp[FILESIZE];
	struct stat	stbuf;
	register char	*cp;

	if ((cp = vms2ux(tmp, dirname)) == NULL)
		return NULL;

	make_filename(cp, cp, NullStr);		/* add SLASH if necessary */
	ux2vms(dp->d_vms_dirname, cp);
	dp->d_context = 0;

	if (get_next_dir_entry(dp) < 0) {
		if (stat(vms2ux(tmp, dirname), &stbuf) < 0 ||
		    !S_IFDIR(stbuf.st_st_mode))
			return NULL;
	}
	/* Determine base length from the first entry (instead of the
	   original dirname), since logical names in the directory
	   specification may be expanded.
	   This allows for trailing "..." wildcard in the directory path,
	   but not for "*" and "%" wildcards.  However, this is inherent to
	   the semantics of {open,read,close}dir. */

	dp->d_baselen = basename(vms2ux(cp, dp->d_next_entry.body)) - cp;

	return dp;
}

struct direct *
readdir(dp)
register DIR	*dp;
{
	static struct direct	thedir;
	register const char	*cp;

	if (dp->d_next_entry.length == 0)	/* exhausted... */
		return NULL;

	cp = vms2ux(thedir.d_name, dp->d_next_entry.body) + dp->d_baselen;

	/* kludge: apparently "*" wildcard used in directory path. */

	if (cp[-1] != '/')
		return NULL;

	strcpy(thedir.d_name, cp);

	get_next_dir_entry(dp);

	return &thedir;
}

void
closedir(dp)
register DIR	*dp;
{
	lib$find_file_end(&dp->d_context);
}

#ifndef READDIR_IMPLEMENTATION

char *
getwd(buf)
char	buf[FILESIZE];
{
	extern char *getcwd();
	char	tmp[FILESIZE];
	int	len;

	if ((len = strlen(vms2ux(buf, getcwd(tmp, sizeof tmp)))) > 0 &&
	    (buf[--len] == '/'))	/* remove trailing slash */
		buf[len] = '\0';

	return buf;
}

#ifdef creat
int
creat(filename, mode)
#undef creat
const char	*filename;
unsigned	mode;
{
	return creat(filename, mode/*, "rfm=var", "rat=cr" /* NO! */);
}
#endif

#ifdef write
private int
ttwrite(buf, size)
const void	*buf;
size_t		size;
{
	struct iosb	iosb;
	static short	ttout ZERO;

	if (!ttout) {
		static	$DESCRIPTOR(sys_output, "SYS$OUTPUT:");
		int	st = sys$assign(&sys_output, &ttout, 0,0);

		if (!$VMS_STATUS_SUCCESS(st))
			_exit(st);
	}
	if (!$VMS_STATUS_SUCCESS(sys$qiow(0, ttout, IO$_WRITEVBLK|IO$M_NOFORMAT,
					  &iosb, 0,0, buf, size, 0,0,0,0)) ||
	    !$VMS_STATUS_SUCCESS(iosb.i_status))
		return -1;

	return iosb.i_count;
}

ssize_t
write(fd, buf, size)
#undef write
int		fd;
const void_*	buf;
size_t		size;
{
	return (fd == 1 && ttraw) ? ttwrite(buf, size) : write(fd, buf, size);
}
#endif

#ifdef getenv
/* This crap is needed since "TERM" is treated specially by VAXC getenv
   in such a way that it does not recognize explicitly set TERM variable.
   (We'd still like to recognize this since not all terminals are DEC
    terminals and could be supported by TERMCAP if not by DECs TERMTABLE)
   {BTW. what good is this name generation anyway if it isn't even the
    name by which the terminal is known in TERMTABLE???} */

private char *
get_symbol(envvar)
const char	*envvar;
{
	STRDESCRIPTOR(vardesc, envvar);
	$DESCRIPTOR(resdesc, genbuf);
	short	reslen;

	if (!$VMS_STATUS_SUCCESS(lib$get_symbol(&vardesc, &resdesc, &reslen)))
		return NULL;

	genbuf[reslen] = '\0';

	return copystr(genbuf);
}

char *
getenv(envvar)
#   undef getenv	/* unhide the real thing */
const char	*envvar;
{
	static char	*TERM ZERO;

	if (strcmp(envvar, "TERM") == 0 &&
	    (TERM || (TERM = get_symbol(envvar))))
		return TERM;

	return getenv(envvar);
}
#endif /* getenv */

#ifdef kill
/* Sending signals to processes other than self doesn't seem to work
   on VMS; make sure that at least SIGKILL is functional. */
int
kill(pid, sig)
#   undef kill
{
	if (sig == SIGKILL) {
		if (!$VMS_STATUS_SUCCESS(vaxc$errno = sys$delprc(&pid, 0))) {
			errno = EVMSERR;
			return -1;
		}
		return 0;
	}
	return kill(pid, sig);
}
#endif

#endif /* READDIR_IMPLEMENTATION */

#endif /* vms */

/*======================================================================
 * $Log: vms.c,v $
 * Revision 14.32  1993/06/14  23:35:12  tom
 * some fixes.
 *
 * Revision 14.31  1993/02/15  02:01:51  tom
 * remove (void) casts.
 *
 * Revision 14.30  1993/01/26  18:43:16  tom
 * cleanup whitespace.
 *
 * Revision 14.28  1992/10/24  01:24:24  tom
 * convert to "port{ansi,defs}.h" conventions.
 *
 * Revision 14.27  1992/09/21  13:16:01  tom
 * use ssize_t with write().
 *
 * Revision 14.26  1992/08/27  02:05:15  tom
 * add RCS directives.
 *
 */
