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
vul_desc(DESC * des,char * str)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
vul_item(ITEM * itm,short len,short cod,char * adr,int * ret)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
mch_settmode(tmode_T tmode)115 mch_settmode(tmode_T 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
set_tty(int row,int col)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
get_tty(void)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
mch_get_shellsize(void)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
mch_set_shellsize(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 *
mch_getenv(char_u * lognam)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 = alloc(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 = alloc(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
mch_setenv(char * var,char * value,int x)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
vms_sys(char * cmd,char * out,char * inp)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 *
vms_tolower(char * name)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
vms_sys_status(int status)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
vms_read(char * inbuf,size_t nbytes)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
vms_wproc(char * name,int val)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 = ALLOC_MULT(char_u *, EXPL_ALLOC_INC);
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 char_u **old_vms_fmatch = vms_fmatch;
408
409 // add more space to store matches
410 vms_match_alloced += EXPL_ALLOC_INC;
411 vms_fmatch = vim_realloc(old_vms_fmatch,
412 sizeof(char **) * vms_match_alloced);
413 if (!vms_fmatch)
414 {
415 vim_free(old_vms_fmatch);
416 return 0;
417 }
418 vms_match_free = EXPL_ALLOC_INC;
419 }
420 vms_fmatch[vms_match_num] = vim_strsave((char_u *)name);
421
422 ++vms_match_num;
423 return 1;
424 }
425
426 /*
427 * mch_expand_wildcards this code does wild-card pattern
428 * matching NOT using the shell
429 *
430 * return OK for success, FAIL for error (you may lose some
431 * memory) and put an error message in *file.
432 *
433 * num_pat number of input patterns
434 * pat array of pointers to input patterns
435 * num_file pointer to number of matched file names
436 * file pointer to array of pointers to matched file names
437 *
438 */
439 int
mch_expand_wildcards(int num_pat,char_u ** pat,int * num_file,char_u *** file,int flags)440 mch_expand_wildcards(int num_pat, char_u **pat, int *num_file, char_u ***file, int flags)
441 {
442 int i, cnt = 0;
443 char_u buf[MAXPATHL];
444 char *result;
445 int dir;
446 int files_alloced, files_free;
447
448 *num_file = 0; // default: no files found
449 files_alloced = EXPL_ALLOC_INC;
450 files_free = EXPL_ALLOC_INC;
451 *file = ALLOC_MULT(char_u *, files_alloced);
452 if (*file == NULL)
453 {
454 *num_file = 0;
455 return FAIL;
456 }
457 for (i = 0; i < num_pat; i++)
458 {
459 // expand environment var or home dir
460 if (vim_strchr(pat[i],'$') || vim_strchr(pat[i],'~'))
461 expand_env(pat[i],buf,MAXPATHL);
462 else
463 STRCPY(buf,pat[i]);
464
465 vms_match_num = 0; // reset collection counter
466 result = decc$translate_vms(vms_fixfilename(buf));
467 if ( (int) result == 0 || (int) result == -1 ) {
468 cnt = 0;
469 } else {
470 cnt = decc$to_vms(result, vms_wproc, 1 /*allow wild*/ , (flags & EW_DIR ? 0:1 ) /*allow directory*/) ;
471 }
472 if (cnt > 0)
473 cnt = vms_match_num;
474
475 if (cnt < 1)
476 continue;
477
478 for (i = 0; i < cnt; i++)
479 {
480 // files should exist if expanding interactively
481 if (!(flags & EW_NOTFOUND) && mch_getperm(vms_fmatch[i]) < 0)
482 continue;
483
484 // do not include directories
485 dir = (mch_isdir(vms_fmatch[i]));
486 if (( dir && !(flags & EW_DIR)) || (!dir && !(flags & EW_FILE)))
487 continue;
488
489 // Skip files that are not executable if we check for that.
490 if (!dir && (flags & EW_EXEC)
491 && !mch_can_exe(vms_fmatch[i], NULL, !(flags & EW_SHELLCMD)))
492 continue;
493
494 // allocate memory for pointers
495 if (--files_free < 1)
496 {
497 char_u **old_file = *file;
498
499 files_alloced += EXPL_ALLOC_INC;
500 *file = vim_realloc(old_file, sizeof(char_u **) * files_alloced);
501 if (*file == NULL)
502 {
503 vim_free(old_file);
504 *file = (char_u **)"";
505 *num_file = 0;
506 return(FAIL);
507 }
508 files_free = EXPL_ALLOC_INC;
509 }
510
511 (*file)[*num_file++] = vms_fmatch[i];
512 }
513 }
514 return OK;
515 }
516
517 int
mch_expandpath(garray_T * gap,char_u * path,int flags)518 mch_expandpath(garray_T *gap, char_u *path, int flags)
519 {
520 int i,cnt = 0;
521 char *result;
522
523 vms_match_num = 0;
524 // the result from the decc$translate_vms needs to be handled
525 // otherwise it might create ACCVIO error in decc$to_vms
526 result = decc$translate_vms(vms_fixfilename(path));
527 if ( (int) result == 0 || (int) result == -1 ) {
528 cnt = 0;
529 } else {
530 cnt = decc$to_vms(result, vms_wproc, 1 /*allow_wild*/, (flags & EW_DIR ? 0:1 ) /*allow directory*/);
531 }
532 if (cnt > 0)
533 cnt = vms_match_num;
534 for (i = 0; i < cnt; i++)
535 {
536 if (mch_getperm(vms_fmatch[i]) >= 0) // add existing file
537 addfile(gap, vms_fmatch[i], flags);
538 }
539 return cnt;
540 }
541
542 /*
543 * attempt to translate a mixed unix-vms file specification to pure vms
544 */
545 static void
vms_unix_mixed_filespec(char * in,char * out)546 vms_unix_mixed_filespec(char *in, char *out)
547 {
548 char *lastcolon;
549 char *end_of_dir;
550 char ch;
551 int len;
552 char *out_str=out;
553
554 // copy vms filename portion up to last colon
555 // (node and/or disk)
556 lastcolon = strrchr(in, ':'); // find last colon
557 if (lastcolon != NULL) {
558 len = lastcolon - in + 1;
559 strncpy(out, in, len);
560 out += len;
561 in += len;
562 }
563
564 end_of_dir = NULL; // default: no directory
565
566 // start of directory portion
567 ch = *in;
568 if ((ch == '[') || (ch == '/') || (ch == '<')) { // start of directory(s) ?
569 ch = '[';
570 SKIP_FOLLOWING_SLASHES(in);
571 } else if (EQN(in, "../", 3)) { // Unix parent directory?
572 *out++ = '[';
573 *out++ = '-';
574 end_of_dir = out;
575 ch = '.';
576 in += 2;
577 SKIP_FOLLOWING_SLASHES(in);
578 } else { // not a special character
579 while (EQN(in, "./", 2)) { // Ignore Unix "current dir"
580 in += 2;
581 SKIP_FOLLOWING_SLASHES(in);
582 }
583 if (strchr(in, '/') == NULL) { // any more Unix directories ?
584 strcpy(out, in); // No - get rest of the spec
585 return;
586 } else {
587 *out++ = '['; // Yes, denote a Vms subdirectory
588 ch = '.';
589 --in;
590 }
591 }
592
593 // if we get here, there is a directory part of the filename
594
595 // initialize output file spec
596 *out++ = ch;
597 ++in;
598
599 while (*in != '\0') {
600 ch = *in;
601 if ((ch == ']') || (ch == '/') || (ch == '>') ) { // end of (sub)directory ?
602 end_of_dir = out;
603 ch = '.';
604 SKIP_FOLLOWING_SLASHES(in);
605 }
606 else if (EQN(in, "../", 3)) { // Unix parent directory?
607 *out++ = '-';
608 end_of_dir = out;
609 ch = '.';
610 in += 2;
611 SKIP_FOLLOWING_SLASHES(in);
612 }
613 else {
614 while (EQN(in, "./", 2)) { // Ignore Unix "current dir"
615 end_of_dir = out;
616 in += 2;
617 SKIP_FOLLOWING_SLASHES(in);
618 ch = *in;
619 }
620 }
621
622 // Place next character into output file spec
623 *out++ = ch;
624 ++in;
625 }
626
627 *out = '\0'; // Terminate output file spec
628
629 if (end_of_dir != NULL) // Terminate directory portion
630 *end_of_dir = ']';
631 }
632
633 /*
634 * for decc$to_vms in vms_fixfilename
635 */
636 static int
vms_fspec_proc(char * fil,int val)637 vms_fspec_proc(char *fil, int val)
638 {
639 strcpy(Fspec_Rms,fil);
640 return(1);
641 }
642
643 /*
644 * change unix and mixed filenames to VMS
645 */
646 void *
vms_fixfilename(void * instring)647 vms_fixfilename(void *instring)
648 {
649 static char *buf = NULL;
650 static size_t buflen = 0;
651 size_t len;
652
653 // get a big-enough buffer
654 len = strlen(instring) + 1;
655 if (len > buflen)
656 {
657 buflen = len + 128;
658 buf = vim_realloc(buf, buflen * sizeof(char));
659 }
660
661 #ifdef DEBUG
662 char *tmpbuf = NULL;
663 tmpbuf = ALLOC_MULT(char, buflen);
664 strcpy(tmpbuf, instring);
665 #endif
666
667 Fspec_Rms = buf; // for decc$to_vms
668
669 if (strchr(instring,'/') == NULL)
670 // It is already a VMS file spec
671 strcpy(buf, instring);
672 else if (strchr(instring,'"') == NULL) // password in the path?
673 {
674 // Seems it is a regular file, let guess that it is pure Unix fspec
675 if ( (strchr(instring,'[') == NULL) && (strchr(instring,'<') == NULL) &&
676 (strchr(instring,']') == NULL) && (strchr(instring,'>') == NULL) &&
677 (strchr(instring,':') == NULL) )
678 {
679 // It must be a truly unix fspec
680 decc$to_vms(instring, vms_fspec_proc, 0, 0);
681 }
682 else
683 {
684 // It is a mixed fspec
685 vms_unix_mixed_filespec(instring, buf);
686 }
687 }
688 else
689 // we have a password in the path
690 // decc$ functions can not handle
691 // this is our only hope to resolv
692 vms_unix_mixed_filespec(instring, buf);
693
694 return buf;
695 }
696
697 /*
698 * Remove version number from file name
699 * we need it in some special cases as:
700 * creating swap file name and writing new file
701 */
702 void
vms_remove_version(void * fname)703 vms_remove_version(void * fname)
704 {
705 char_u *cp;
706 char_u *fp;
707
708 if ((cp = vim_strchr( fname, ';')) != NULL) // remove version
709 *cp = '\0';
710 else if ((cp = vim_strrchr( fname, '.')) != NULL )
711 {
712 if ((fp = vim_strrchr( fname, ']')) != NULL ) {;}
713 else if ((fp = vim_strrchr( fname, '>')) != NULL ) {;}
714 else fp = fname;
715
716 while ( *fp != '\0' && fp < cp )
717 if ( *fp++ == '.' )
718 *cp = '\0';
719 }
720 return ;
721 }
722
723 struct typeahead_st {
724 unsigned short numchars;
725 unsigned char firstchar;
726 unsigned char reserved0;
727 unsigned long reserved1;
728 } typeahead;
729
730 /*
731 * Wait "msec" msec until a character is available from file descriptor "fd".
732 * "msec" == 0 will check for characters once.
733 * "msec" == -1 will block until a character is available.
734 */
735 int
RealWaitForChar(int fd UNUSED,long msec,int * check_for_gpm UNUSED,int * interrupted)736 RealWaitForChar(
737 int fd UNUSED, // always read from iochan
738 long msec,
739 int *check_for_gpm UNUSED,
740 int *interrupted)
741 {
742 int status;
743 struct _generic_64 time_curr;
744 struct _generic_64 time_diff;
745 struct _generic_64 time_out;
746 unsigned int convert_operation = LIB$K_DELTA_SECONDS_F;
747 float sec =(float) msec/1000;
748
749 // make sure the iochan is set
750 if (!iochan)
751 get_tty();
752
753 if (sec > 0) {
754 // time-out specified; convert it to absolute time
755 // sec>0 requirement of lib$cvtf_to_internal_time()
756
757 // get current time (number of 100ns ticks since the VMS Epoch)
758 status = sys$gettim(&time_curr);
759 if (status != SS$_NORMAL)
760 return 0; // error
761 // construct the delta time
762 #if __G_FLOAT==0
763 # ifndef VAX
764 // IEEE is default on IA64, but can be used on Alpha too - but not on VAX
765 status = lib$cvts_to_internal_time(
766 &convert_operation, &sec, &time_diff);
767 # endif
768 #else // default on Alpha and VAX
769 status = lib$cvtf_to_internal_time(
770 &convert_operation, &sec, &time_diff);
771 #endif
772 if (status != LIB$_NORMAL)
773 return 0; // error
774 // add them up
775 status = lib$add_times(
776 &time_curr,
777 &time_diff,
778 &time_out);
779 if (status != LIB$_NORMAL)
780 return 0; // error
781 }
782
783 while (TRUE) {
784 // select()
785 status = sys$qiow(0, iochan, IO$_SENSEMODE | IO$M_TYPEAHDCNT, iosb,
786 0, 0, &typeahead, 8, 0, 0, 0, 0);
787 if (status != SS$_NORMAL || (iosb[0] & 0xFFFF) != SS$_NORMAL)
788 return 0; // error
789
790 if (typeahead.numchars)
791 return 1; // ready to read
792
793 // there's nothing to read; what now?
794 if (msec == 0) {
795 // immediate time-out; return impatiently
796 return 0;
797 } else if (msec < 0) {
798 // no time-out; wait on indefinitely
799 return 1; // fakeout to force a wait in vms_read()
800 } else {
801 // time-out needs to be checked
802 status = sys$gettim(&time_curr);
803 if (status != SS$_NORMAL)
804 return 0; // error
805
806 status = lib$sub_times(
807 &time_out,
808 &time_curr,
809 &time_diff);
810 if (status != LIB$_NORMAL)
811 return 0; // error, incl. time_diff < 0 (i.e. time-out)
812
813 // otherwise wait some more
814 }
815 }
816 }
817