xref: /vim-8.2.3635/src/os_vms.c (revision 94688b8a)
1 /* vi:set ts=8 sts=4 sw=4 noet:
2  *
3  * VIM - Vi IMproved		by Bram Moolenaar
4  * VMS port			by Henk Elbers
5  * VMS deport			by Zoltan Arpadffy
6  *
7  * Do ":help uganda"  in Vim to read copying and usage conditions.
8  * Do ":help credits" in Vim to see a list of people who contributed.
9  * See README.txt for an overview of the Vim source code.
10  */
11 
12 #include	"vim.h"
13 
14 /* define _generic_64 for use in time functions */
15 #if !defined(VAX) && !defined(PROTO)
16 #   include <gen64def.h>
17 #else
18 /* based on Alpha's gen64def.h; the file is absent on VAX */
19 typedef struct _generic_64 {
20 #   pragma __nomember_alignment
21     __union  {				/* You can treat me as...  */
22 	/* long long is not available on VAXen */
23 	/* unsigned __int64 gen64$q_quadword; ...a single 64-bit value, or */
24 
25 	unsigned int gen64$l_longword [2]; /* ...two 32-bit values, or */
26 	unsigned short int gen64$w_word [4]; /* ...four 16-bit values */
27     } gen64$r_quad_overlay;
28 } GENERIC_64;
29 #endif
30 
31 typedef struct
32 {
33     char	class;
34     char	type;
35     short	width;
36     union
37     {
38 	struct
39 	{
40 	    char	_basic[3];
41 	    char	length;
42 	}	y;
43 	int	basic;
44     }	x;
45     int		extended;
46 }	TT_MODE;
47 
48 typedef struct
49 {
50     short	buflen;
51     short	itemcode;
52     char	*bufadrs;
53     int		*retlen;
54 }	ITEM;
55 
56 typedef struct
57 {
58     ITEM	equ;
59     int		nul;
60 }	ITMLST1;
61 
62 typedef struct
63 {
64     ITEM	index;
65     ITEM	string;
66     int	nul;
67 }	ITMLST2;
68 
69 static TT_MODE	orgmode;
70 static short	iochan;			/* TTY I/O channel */
71 static short	iosb[4];		/* IO status block */
72 
73 static int vms_match_num = 0;
74 static int vms_match_free = 0;
75 static char_u **vms_fmatch = NULL;
76 static char *Fspec_Rms;		       /* rms file spec, passed implicitly between routines */
77 
78 
79 
80 static TT_MODE	get_tty(void);
81 static void	set_tty(int row, int col);
82 
83 #define EXPL_ALLOC_INC 64
84 
85 #define EQN(S1,S2,LN) (strncmp(S1,S2,LN) == 0)
86 #define SKIP_FOLLOWING_SLASHES(Str) do { while (Str[1] == '/') ++Str; } while (0)
87 
88 
89 /*
90  *	vul_desc	vult een descriptor met een string en de lengte
91  *			hier van.
92  */
93     static void
94 vul_desc(DESC *des, char *str)
95 {
96     des->dsc$b_dtype = DSC$K_DTYPE_T;
97     des->dsc$b_class = DSC$K_CLASS_S;
98     des->dsc$a_pointer = str;
99     des->dsc$w_length = str ? strlen(str) : 0;
100 }
101 
102 /*
103  *	vul_item	vult een item met een aantal waarden
104  */
105     static void
106 vul_item(ITEM *itm, short len, short cod, char *adr, int *ret)
107 {
108     itm->buflen   = len;
109     itm->itemcode = cod;
110     itm->bufadrs  = adr;
111     itm->retlen   = ret;
112 }
113 
114     void
115 mch_settmode(int tmode)
116 {
117     int	status;
118 
119     if ( tmode == TMODE_RAW )
120 	set_tty(0, 0);
121     else{
122 	switch (orgmode.width)
123 	{
124 	    case 132:	OUT_STR_NF((char_u *)"\033[?3h\033>");	break;
125 	    case 80:	OUT_STR_NF((char_u *)"\033[?3l\033>");	break;
126 	    default:	break;
127 	}
128 	out_flush();
129 	status = sys$qiow(0, iochan, IO$_SETMODE, iosb, 0, 0,
130 					  &orgmode, sizeof(TT_MODE), 0,0,0,0);
131 	if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
132 	    return;
133 	(void)sys$dassgn(iochan);
134 	iochan = 0;
135     }
136 }
137 
138     static void
139 set_tty(int row, int col)
140 {
141     int		    status;
142     TT_MODE	    newmode;		/* New TTY mode bits		*/
143     static short    first_time = TRUE;
144 
145     if (first_time)
146     {
147 	orgmode = get_tty();
148 	first_time = FALSE;
149     }
150     newmode = get_tty();
151     if (col)
152 	newmode.width		 = col;
153     if (row)
154 	newmode.x.y.length       = row;
155     newmode.x.basic		|= (TT$M_NOECHO | TT$M_HOSTSYNC);
156     newmode.x.basic		&= ~TT$M_TTSYNC;
157     newmode.extended		|= TT2$M_PASTHRU;
158     status = sys$qiow(0, iochan, IO$_SETMODE, iosb, 0, 0,
159 			  &newmode, sizeof(newmode), 0, 0, 0, 0);
160     if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
161 	return;
162 }
163 
164     static TT_MODE
165 get_tty(void)
166 {
167 
168     static $DESCRIPTOR(odsc,"SYS$OUTPUT");   /* output descriptor */
169 
170     int		status;
171     TT_MODE	tt_mode;
172 
173     if (!iochan)
174 	status = sys$assign(&odsc,&iochan,0,0);
175 
176     status = sys$qiow(0, iochan, IO$_SENSEMODE, iosb, 0, 0,
177 		      &tt_mode, sizeof(tt_mode), 0, 0, 0, 0);
178     if (status != SS$_NORMAL || (iosb[0] & 0xFFFF) != SS$_NORMAL)
179     {
180 	tt_mode.width		= 0;
181 	tt_mode.type		= 0;
182 	tt_mode.class		= 0;
183 	tt_mode.x.basic		= 0;
184 	tt_mode.x.y.length	= 0;
185 	tt_mode.extended	= 0;
186     }
187     return(tt_mode);
188 }
189 
190 /*
191  * Get the current window size in Rows and Columns.
192  */
193     int
194 mch_get_shellsize(void)
195 {
196     TT_MODE	tmode;
197 
198     tmode = get_tty();			/* get size from VMS	*/
199     Columns = tmode.width;
200     Rows = tmode.x.y.length;
201     return OK;
202 }
203 
204 /*
205  * Try to set the window size to Rows and new_Columns.
206  */
207     void
208 mch_set_shellsize(void)
209 {
210     set_tty(Rows, Columns);
211     switch (Columns)
212     {
213 	case 132:	OUT_STR_NF((char_u *)"\033[?3h\033>");	break;
214 	case 80:	OUT_STR_NF((char_u *)"\033[?3l\033>");	break;
215 	default:	break;
216     }
217     out_flush();
218     screen_start();
219 }
220 
221     char_u *
222 mch_getenv(char_u *lognam)
223 {
224     DESC		d_file_dev, d_lognam  ;
225     static char		buffer[LNM$C_NAMLENGTH+1];
226     char_u		*cp = NULL;
227     unsigned long	attrib;
228     int			lengte = 0, dum = 0, idx = 0;
229     ITMLST2		itmlst;
230     char		*sbuf = NULL;
231 
232     vul_desc(&d_lognam, (char *)lognam);
233     vul_desc(&d_file_dev, "LNM$FILE_DEV");
234     attrib = LNM$M_CASE_BLIND;
235     vul_item(&itmlst.index, sizeof(int), LNM$_INDEX, (char *)&idx, &dum);
236     vul_item(&itmlst.string, LNM$C_NAMLENGTH, LNM$_STRING, buffer, &lengte);
237     itmlst.nul	= 0;
238     if (sys$trnlnm(&attrib, &d_file_dev, &d_lognam, NULL,&itmlst) == SS$_NORMAL)
239     {
240 	buffer[lengte] = '\0';
241 	if (cp = (char_u *)alloc((unsigned)(lengte+1)))
242 	    strcpy((char *)cp, buffer);
243 	return(cp);
244     }
245     else if ((sbuf = getenv((char *)lognam)))
246     {
247 	lengte = strlen(sbuf) + 1;
248 	cp = (char_u *)alloc((size_t)lengte);
249 	if (cp)
250 	    strcpy((char *)cp, sbuf);
251 	return cp;
252     }
253     else
254 	return(NULL);
255 }
256 
257 /*
258  *	mch_setenv	VMS version of setenv()
259  */
260     int
261 mch_setenv(char *var, char *value, int x)
262 {
263     int		res, dum;
264     long	attrib = 0L;
265     char	acmode = PSL$C_SUPER;	/* needs SYSNAM privilege */
266     DESC	tabnam, lognam;
267     ITMLST1	itmlst;
268 
269     vul_desc(&tabnam, "LNM$JOB");
270     vul_desc(&lognam, var);
271     vul_item(&itmlst.equ, value ? strlen(value) : 0, value ? LNM$_STRING : 0,
272 	    value, &dum);
273     itmlst.nul	= 0;
274     res = sys$crelnm(&attrib, &tabnam, &lognam, &acmode, &itmlst);
275     return((res == 1) ? 0 : -1);
276 }
277 
278     int
279 vms_sys(char *cmd, char *out, char *inp)
280 {
281     DESC	cdsc, odsc, idsc;
282     long	status;
283 
284     if (cmd)
285 	vul_desc(&cdsc, cmd);
286     if (out)
287 	vul_desc(&odsc, out);
288     if (inp)
289 	vul_desc(&idsc, inp);
290 
291     lib$spawn(cmd ? &cdsc : NULL,		/* command string */
292 	      inp ? &idsc : NULL,		/* input file */
293 	      out ? &odsc : NULL,		/* output file */
294 	      0, 0, 0, &status, 0, 0, 0, 0, 0, 0);
295     return status;
296 }
297 
298 /*
299  * Convert string to lowercase - most often filename
300  */
301     char *
302 vms_tolower( char *name )
303 {
304     int i,nlen = strlen(name);
305     for (i = 0; i < nlen; i++)
306 	name[i] = TOLOWER_ASC(name[i]);
307     return name;
308 }
309 
310 /*
311  * Convert VMS system() or lib$spawn() return code to Unix-like exit value.
312  */
313     int
314 vms_sys_status(int status)
315 {
316     if (status != SS$_NORMAL && (status & STS$M_SUCCESS) == 0)
317 	return status;		/* Command failed. */
318     return 0;
319 }
320 
321 /*
322  * vms_read()
323  * function for low level char input
324  *
325  * Returns: input length
326  */
327     int
328 vms_read(char *inbuf, size_t nbytes)
329 {
330     int		status, function, len;
331     TT_MODE	tt_mode;
332     ITEM	itmlst[2];     /* terminates on everything */
333     static long trm_mask[8] = {-1, -1, -1, -1, -1, -1, -1, -1};
334 
335     /* whatever happened earlier we need an iochan here */
336     if (!iochan)
337 	tt_mode = get_tty();
338 
339     /* important: clean the inbuf */
340     memset(inbuf, 0, nbytes);
341 
342     /* set up the itemlist for the first read */
343     vul_item(&itmlst[0], 0, TRM$_MODIFIERS,
344 	 (char *)( TRM$M_TM_NOECHO  | TRM$M_TM_NOEDIT	 |
345 		   TRM$M_TM_NOFILTR | TRM$M_TM_TRMNOECHO |
346 		   TRM$M_TM_NORECALL) , 0);
347     vul_item(&itmlst[1], sizeof(trm_mask), TRM$_TERM, (char *)&trm_mask, 0);
348 
349     /* wait forever for a char */
350     function = (IO$_READLBLK | IO$M_EXTEND);
351     status = sys$qiow(0, iochan, function, &iosb, 0, 0,
352 			 inbuf, nbytes-1, 0, 0, &itmlst, sizeof(itmlst));
353     len = strlen(inbuf); /* how many chars we got? */
354 
355     /* read immediately the rest in the IO queue   */
356     function = (IO$_READLBLK | IO$M_TIMED | IO$M_ESCAPE | IO$M_NOECHO | IO$M_NOFILTR);
357     status = sys$qiow(0, iochan, function, &iosb, 0, 0,
358 			 inbuf+len, nbytes-1-len, 0, 0, 0, 0);
359 
360     len = strlen(inbuf); /* return the total length */
361 
362     return len;
363 }
364 
365 /*
366  * vms_wproc() is called for each matching filename by decc$to_vms().
367  * We want to save each match for later retrieval.
368  *
369  * Returns:  1 - continue finding matches
370  *	     0 - stop trying to find any further matches
371  */
372     static int
373 vms_wproc(char *name, int val)
374 {
375     int i;
376     static int vms_match_alloced = 0;
377 
378     if (val == DECC$K_FOREIGN ) /* foreign non VMS files are not counting */
379 	return 1;
380 
381     /* accept all DECC$K_FILE and DECC$K_DIRECTORY */
382     if (vms_match_num == 0) {
383 	/* first time through, setup some things */
384 	if (NULL == vms_fmatch) {
385 	    vms_fmatch = (char_u **)alloc(EXPL_ALLOC_INC * sizeof(char *));
386 	    if (!vms_fmatch)
387 		return 0;
388 	    vms_match_alloced = EXPL_ALLOC_INC;
389 	    vms_match_free = EXPL_ALLOC_INC;
390 	}
391 	else {
392 	    /* re-use existing space */
393 	    vms_match_free = vms_match_alloced;
394 	}
395     }
396 
397     /* make matches look uniform */
398     vms_remove_version(name);
399     name=vms_tolower(name);
400 
401     /* if name already exists, don't add it */
402     for (i = 0; i<vms_match_num; i++) {
403 	if (0 == STRCMP((char_u *)name,vms_fmatch[i]))
404 	    return 1;
405     }
406     if (--vms_match_free == 0) {
407 	/* add more space to store matches */
408 	vms_match_alloced += EXPL_ALLOC_INC;
409 	vms_fmatch = (char_u **)vim_realloc(vms_fmatch,
410 		sizeof(char **) * vms_match_alloced);
411 	if (!vms_fmatch)
412 	    return 0;
413 	vms_match_free = EXPL_ALLOC_INC;
414     }
415     vms_fmatch[vms_match_num] = vim_strsave((char_u *)name);
416 
417     ++vms_match_num;
418     return 1;
419 }
420 
421 /*
422  *	mch_expand_wildcards	this code does wild-card pattern
423  *				matching NOT using the shell
424  *
425  *	return OK for success, FAIL for error (you may lose some
426  *	memory) and put an error message in *file.
427  *
428  *	num_pat	   number of input patterns
429  *	pat	   array of pointers to input patterns
430  *	num_file   pointer to number of matched file names
431  *	file	   pointer to array of pointers to matched file names
432  *
433  */
434     int
435 mch_expand_wildcards(int num_pat, char_u **pat, int *num_file, char_u ***file, int flags)
436 {
437     int		i, cnt = 0;
438     char_u	buf[MAXPATHL];
439     char       *result;
440     int		dir;
441     int files_alloced, files_free;
442 
443     *num_file = 0;			/* default: no files found	*/
444     files_alloced = EXPL_ALLOC_INC;
445     files_free = EXPL_ALLOC_INC;
446     *file = (char_u **) alloc(sizeof(char_u **) * files_alloced);
447     if (*file == NULL)
448     {
449 	*num_file = 0;
450 	return FAIL;
451     }
452     for (i = 0; i < num_pat; i++)
453     {
454 	/* expand environment var or home dir */
455 	if (vim_strchr(pat[i],'$') || vim_strchr(pat[i],'~'))
456 	    expand_env(pat[i],buf,MAXPATHL);
457 	else
458 	    STRCPY(buf,pat[i]);
459 
460 	vms_match_num = 0; /* reset collection counter */
461 	result = decc$translate_vms(vms_fixfilename(buf));
462 	if ( (int) result == 0 || (int) result == -1  ) {
463 	    cnt = 0;
464 	} else {
465 	    cnt = decc$to_vms(result, vms_wproc, 1 /*allow wild*/ , (flags & EW_DIR ? 0:1 ) /*allow directory*/) ;
466 	}
467 	if (cnt > 0)
468 	    cnt = vms_match_num;
469 
470 	if (cnt < 1)
471 	    continue;
472 
473 	for (i = 0; i < cnt; i++)
474 	{
475 	    /* files should exist if expanding interactively */
476 	    if (!(flags & EW_NOTFOUND) && mch_getperm(vms_fmatch[i]) < 0)
477 		continue;
478 
479 	    /* do not include directories */
480 	    dir = (mch_isdir(vms_fmatch[i]));
481 	    if (( dir && !(flags & EW_DIR)) || (!dir && !(flags & EW_FILE)))
482 		continue;
483 
484 	    /* Skip files that are not executable if we check for that. */
485 	    if (!dir && (flags & EW_EXEC)
486 		 && !mch_can_exe(vms_fmatch[i], NULL, !(flags & EW_SHELLCMD)))
487 		continue;
488 
489 	    /* allocate memory for pointers */
490 	    if (--files_free < 1)
491 	    {
492 		files_alloced += EXPL_ALLOC_INC;
493 		*file = (char_u **)vim_realloc(*file,
494 		    sizeof(char_u **) * files_alloced);
495 		if (*file == NULL)
496 		{
497 		    *file = (char_u **)"";
498 		    *num_file = 0;
499 		    return(FAIL);
500 		}
501 		files_free = EXPL_ALLOC_INC;
502 	    }
503 
504 	    (*file)[*num_file++] = vms_fmatch[i];
505 	}
506     }
507     return OK;
508 }
509 
510     int
511 mch_expandpath(garray_T *gap, char_u *path, int flags)
512 {
513     int		i,cnt = 0;
514     char       *result;
515 
516     vms_match_num = 0;
517     /* the result from the decc$translate_vms needs to be handled */
518     /* otherwise it might create ACCVIO error in decc$to_vms      */
519     result = decc$translate_vms(vms_fixfilename(path));
520     if ( (int) result == 0 || (int) result == -1  ) {
521 	cnt = 0;
522     } else {
523 	cnt = decc$to_vms(result, vms_wproc, 1 /*allow_wild*/, (flags & EW_DIR ? 0:1 ) /*allow directory*/);
524     }
525     if (cnt > 0)
526 	cnt = vms_match_num;
527     for (i = 0; i < cnt; i++)
528     {
529 	if (mch_getperm(vms_fmatch[i]) >= 0) /* add existing file */
530 	    addfile(gap, vms_fmatch[i], flags);
531     }
532     return cnt;
533 }
534 
535 /*
536  * attempt to translate a mixed unix-vms file specification to pure vms
537  */
538     static void
539 vms_unix_mixed_filespec(char *in, char *out)
540 {
541     char *lastcolon;
542     char *end_of_dir;
543     char ch;
544     int len;
545     char *out_str=out;
546 
547     /* copy vms filename portion up to last colon
548      * (node and/or disk)
549      */
550     lastcolon = strrchr(in, ':');   /* find last colon */
551     if (lastcolon != NULL) {
552 	len = lastcolon - in + 1;
553 	strncpy(out, in, len);
554 	out += len;
555 	in += len;
556     }
557 
558     end_of_dir = NULL;	/* default: no directory */
559 
560     /* start of directory portion */
561     ch = *in;
562     if ((ch == '[') || (ch == '/') || (ch == '<')) {	/* start of directory(s) ? */
563 	ch = '[';
564 	SKIP_FOLLOWING_SLASHES(in);
565     } else if (EQN(in, "../", 3)) { /* Unix parent directory? */
566 	*out++ = '[';
567 	*out++ = '-';
568 	end_of_dir = out;
569 	ch = '.';
570 	in += 2;
571 	SKIP_FOLLOWING_SLASHES(in);
572     } else {		    /* not a special character */
573 	while (EQN(in, "./", 2)) {	/* Ignore Unix "current dir" */
574 	    in += 2;
575 	    SKIP_FOLLOWING_SLASHES(in);
576     }
577     if (strchr(in, '/') == NULL) {  /* any more Unix directories ? */
578 	strcpy(out, in);	/* No - get rest of the spec */
579 	return;
580     } else {
581 	*out++ = '[';	    /* Yes, denote a Vms subdirectory */
582 	ch = '.';
583 	--in;
584 	}
585     }
586 
587     /* if we get here, there is a directory part of the filename */
588 
589     /* initialize output file spec */
590     *out++ = ch;
591     ++in;
592 
593     while (*in != '\0') {
594 	ch = *in;
595 	if ((ch == ']') || (ch == '/') || (ch == '>') ) {	/* end of (sub)directory ? */
596 	    end_of_dir = out;
597 	    ch = '.';
598 	    SKIP_FOLLOWING_SLASHES(in);
599 	    }
600 	else if (EQN(in, "../", 3)) {	/* Unix parent directory? */
601 	    *out++ = '-';
602 	    end_of_dir = out;
603 	    ch = '.';
604 	    in += 2;
605 	    SKIP_FOLLOWING_SLASHES(in);
606 	    }
607 	else {
608 	    while (EQN(in, "./", 2)) {  /* Ignore Unix "current dir" */
609 	    end_of_dir = out;
610 	    in += 2;
611 	    SKIP_FOLLOWING_SLASHES(in);
612 	    ch = *in;
613 	    }
614 	}
615 
616     /* Place next character into output file spec */
617 	*out++ = ch;
618 	++in;
619     }
620 
621     *out = '\0';    /* Terminate output file spec */
622 
623     if (end_of_dir != NULL) /* Terminate directory portion */
624 	*end_of_dir = ']';
625 }
626 
627 /*
628  * for decc$to_vms in vms_fixfilename
629  */
630     static int
631 vms_fspec_proc(char *fil, int val)
632 {
633     strcpy(Fspec_Rms,fil);
634     return(1);
635 }
636 
637 /*
638  * change unix and mixed filenames to VMS
639  */
640     void *
641 vms_fixfilename(void *instring)
642 {
643     static char		*buf = NULL;
644     static size_t	buflen = 0;
645     size_t		len;
646 
647     /* get a big-enough buffer */
648     len = strlen(instring) + 1;
649     if (len > buflen)
650     {
651 	buflen = len + 128;
652 	if (buf)
653 	    buf = (char *)vim_realloc(buf, buflen);
654 	else
655 	    buf = (char *)alloc(buflen * sizeof(char));
656     }
657 
658 #ifdef DEBUG
659      char		 *tmpbuf = NULL;
660      tmpbuf = (char *)alloc(buflen * sizeof(char));
661      strcpy(tmpbuf, instring);
662 #endif
663 
664     Fspec_Rms = buf;				/* for decc$to_vms */
665 
666     if (strchr(instring,'/') == NULL)
667 	/* It is already a VMS file spec */
668 	strcpy(buf, instring);
669     else if (strchr(instring,'"') == NULL)	/* password in the path? */
670     {
671 	/* Seems it is a regular file, let guess that it is pure Unix fspec */
672 	if (decc$to_vms(instring, vms_fspec_proc, 0, 0) <= 0)
673 	    /* No... it must be mixed */
674 	    vms_unix_mixed_filespec(instring, buf);
675     }
676     else
677 	/* we have a password in the path   */
678 	/* decc$ functions can not handle   */
679 	/* this is our only hope to resolv  */
680 	vms_unix_mixed_filespec(instring, buf);
681 
682     return buf;
683 }
684 
685 /*
686  * Remove version number from file name
687  * we need it in some special cases as:
688  * creating swap file name and writing new file
689  */
690     void
691 vms_remove_version(void * fname)
692 {
693     char_u	*cp;
694     char_u	*fp;
695 
696     if ((cp = vim_strchr( fname, ';')) != NULL) /* remove version */
697 	*cp = '\0';
698     else if ((cp = vim_strrchr( fname, '.')) != NULL )
699     {
700 	if      ((fp = vim_strrchr( fname, ']')) != NULL ) {;}
701 	else if ((fp = vim_strrchr( fname, '>')) != NULL ) {;}
702 	else fp = fname;
703 
704 	while ( *fp != '\0' && fp < cp )
705 	    if ( *fp++ == '.' )
706 		*cp = '\0';
707     }
708     return ;
709 }
710 
711 struct typeahead_st {
712     unsigned short numchars;
713     unsigned char  firstchar;
714     unsigned char  reserved0;
715     unsigned long  reserved1;
716 } typeahead;
717 
718 /*
719  * Wait "msec" msec until a character is available from file descriptor "fd".
720  * "msec" == 0 will check for characters once.
721  * "msec" == -1 will block until a character is available.
722  */
723     int
724 RealWaitForChar(
725     int		fd UNUSED, /* always read from iochan */
726     long	msec,
727     int		*check_for_gpm UNUSED,
728     int		*interrupted)
729 {
730     int status;
731     struct _generic_64 time_curr;
732     struct _generic_64 time_diff;
733     struct _generic_64 time_out;
734     unsigned int convert_operation = LIB$K_DELTA_SECONDS_F;
735     float sec =(float) msec/1000;
736 
737     /* make sure the iochan is set */
738     if (!iochan)
739 	get_tty();
740 
741     if (sec > 0) {
742 	/* time-out specified; convert it to absolute time */
743 	/* sec>0 requirement of lib$cvtf_to_internal_time()*/
744 
745 	/* get current time (number of 100ns ticks since the VMS Epoch) */
746 	status = sys$gettim(&time_curr);
747 	if (status != SS$_NORMAL)
748 	    return 0; /* error */
749 	/* construct the delta time */
750 #if __G_FLOAT==0
751 # ifndef VAX
752 	/* IEEE is default on IA64, but can be used on Alpha too - but not on VAX */
753 	status = lib$cvts_to_internal_time(
754 		&convert_operation, &sec, &time_diff);
755 # endif
756 #else   /* default on Alpha and VAX  */
757 	status = lib$cvtf_to_internal_time(
758 		&convert_operation, &sec, &time_diff);
759 #endif
760 	if (status != LIB$_NORMAL)
761 	    return 0; /* error */
762 	/* add them up */
763 	status = lib$add_times(
764 		&time_curr,
765 		&time_diff,
766 		&time_out);
767 	if (status != LIB$_NORMAL)
768 	    return 0; /* error */
769     }
770 
771     while (TRUE) {
772 	/* select() */
773 	status = sys$qiow(0, iochan, IO$_SENSEMODE | IO$M_TYPEAHDCNT, iosb,
774 		0, 0, &typeahead, 8, 0, 0, 0, 0);
775 	if (status != SS$_NORMAL || (iosb[0] & 0xFFFF) != SS$_NORMAL)
776 	    return 0; /* error */
777 
778 	if (typeahead.numchars)
779 	    return 1; /* ready to read */
780 
781 	/* there's nothing to read; what now? */
782 	if (msec == 0) {
783 	    /* immediate time-out; return impatiently */
784 	    return 0;
785 	} else if (msec < 0) {
786 	    /* no time-out; wait on indefinitely */
787 	    return 1; /* fakeout to force a wait in vms_read() */
788 	} else {
789 	    /* time-out needs to be checked */
790 	    status = sys$gettim(&time_curr);
791 	    if (status != SS$_NORMAL)
792 		return 0; /* error */
793 
794 	    status = lib$sub_times(
795 		    &time_out,
796 		    &time_curr,
797 		    &time_diff);
798 	    if (status != LIB$_NORMAL)
799 		return 0; /* error, incl. time_diff < 0 (i.e. time-out) */
800 
801 	    /* otherwise wait some more */
802 	}
803     }
804 }
805