1 /* vms_misc.c -- sustitute code for missing/different run-time library routines.
2
3 Copyright (C) 1991-1993, 1996-1997, 2001, 2003, 2009, 2010, 2011, 2014, 2022, 2023,
4 the Free Software Foundation, Inc.
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 3, or (at your option)
9 any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software Foundation,
18 Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
19
20 #define creat creat_dummy /* one of gcc-vms's headers has bad prototype */
21 #include "awk.h"
22 #include "vms.h"
23 #undef creat
24 #include <fab.h>
25 #ifndef O_RDONLY
26 #include <fcntl.h>
27 #endif
28 #include <rmsdef.h>
29 #include <ssdef.h>
30 #include <stsdef.h>
31
32 /*
33 * In VMS's VAXCRTL, strerror() takes an optional second argument.
34 * #define strerror(errnum) strerror(errnum,vaxc$errno)
35 * is all that's needed, but VAXC can't handle that (gcc can).
36 * [The 2nd arg is used iff errnum == EVMSERR.]
37 */
38 #ifdef strerror
39 # undef strerror
40 #endif
41 extern char *strerror(int,...);
42
43 /* vms_strerror() -- convert numeric error code into text string */
44 char *
45 vms_strerror( int errnum )
46 {
47 return ( errnum != EVMSERR ? strerror(errnum)
48 : strerror(EVMSERR, vaxc$errno) );
49 }
50 # define strerror(v) vms_strerror(v)
51
52 /*
53 * Miscellaneous utility routine, not part of the run-time library.
54 */
55 /* vms_strdup() - allocate some new memory and copy a string into it */
56 char *
57 vms_strdup( const char *str )
58 {
59 char *result;
60 int len = strlen(str);
61
62 emalloc(result, char *, len+1, "strdup");
63 return strcpy(result, str);
64 }
65
66 /*
67 * VAXCRTL does not contain unlink(). This replacement has limited
68 * functionality which is sufficient for GAWK's needs. It works as
69 * desired even when we have the file open.
70 */
71 /* unlink(file) -- delete a file (ignore soft links) */
72 int
73 unlink( const char *file_spec ) {
74 char tmp[255+1]; /*(should use alloca(len+2+1)) */
75 extern int delete(const char *);
76
77 strcpy(tmp, file_spec); /* copy file name */
78 if (strchr(tmp, ';') == NULL)
79 strcat(tmp, ";0"); /* append version number */
80 return delete(tmp);
81 }
82
83 /*
84 * Work-around an open(O_CREAT+O_TRUNC) bug (screwed up modification
85 * and creation dates when new version is created), and also use some
86 * VMS-specific file options. Note: optional 'prot' arg is completely
87 * ignored; gawk doesn't need it.
88 */
89 #ifdef open
90 # undef open
91 #endif
92 extern int creat(const char *,int,...);
93 extern int open(const char *,int,unsigned,...);
94
95 /* vms_open() - open a file, possibly creating it */
96 int
97 vms_open( const char *name, int mode, ... )
98 {
99 int result;
100
101 if (strncmp(name, "/dev/", 5) == 0) {
102 /* (this used to be handled in vms_devopen(), but that is only
103 called when opening files for output; we want it for input too) */
104 if (strcmp(name + 5, "null") == 0) /* /dev/null -> NL: */
105 name = "NL:";
106 else if (strcmp(name + 5, "tty") == 0) /* /dev/tty -> TT: */
107 name = "TT:";
108 }
109
110 if (mode == (O_WRONLY|O_CREAT|O_TRUNC)) {
111 /* explicitly force stream_lf record format to override DECC$SHR's
112 defaulting of RFM to earlier file version's when one is present */
113 /* 3.1.7 fix: letting record attibutes default resulted in DECC$SHR's
114 creat() failing with "invalid record attributes" when trying to
115 make a new version of an existing file which had rfm=vfc,rat=prn
116 format, so add explicit "rat=cr" to go with rfm=stmlf to force
117 the usual "carriage return carriage control" setting */
118 result = creat(name, 0, "rfm=stmlf", "rat=cr", "shr=nil", "mbc=32");
119 } else {
120 struct stat stb;
121 int stat_result;
122 const char *mbc, *shr = "shr=get", *ctx = "ctx=stm";
123
124 stat_result = stat((char *)name, &stb);
125 if ( stat_result < 0) { /* assume DECnet */
126 mbc = "mbc=8";
127 } else { /* ordinary file; allow full sharing iff record format */
128 mbc = "mbc=32";
129 if ((stb.st_fab_rfm & 0x0F) < FAB$C_STM) shr = "shr=get,put,upd";
130 }
131 result = open(name, mode, 0, shr, mbc, "mbf=2");
132 if ((stat_result >= 0) && (result < 0) && (errno == ENOENT)) {
133 /* ENOENT not possible because stat succeeded */
134 errno = EMFILE;
135 if (S_ISDIR(stb.st_mode)) {
136 errno = EISDIR; /* Bug seen in VMS 8.3 */
137 }
138 }
139 }
140
141 /* This is only approximate; the ACP -> RMS -> VAXCRTL interface
142 discards too much potentially useful status information... */
143 if (result < 0 && errno == EVMSERR
144 && (vaxc$errno == RMS$_ACC || vaxc$errno == RMS$_CRE))
145 errno = EMFILE; /* redirect() should close 1 file & try again */
146
147 return result;
148 }
149
150 /*
151 * Check for attempt to (re-)open known file.
152 */
153 /* vms_devopen() - check for "SYS$INPUT" or "SYS$OUTPUT" or "SYS$ERROR" */
154 int
155 vms_devopen( const char *name, int mode )
156 {
157 FILE *file = NULL;
158
159 if (strncasecmp(name, "SYS$", 4) == 0) {
160 name += 4; /* skip "SYS$" */
161 if (strncasecmp(name, "INPUT", 5) == 0 && (mode & O_WRONLY) == 0)
162 file = stdin, name += 5;
163 else if (strncasecmp(name, "OUTPUT", 6) == 0 && (mode & O_WRONLY) != 0)
164 file = stdout, name += 6;
165 else if (strncasecmp(name, "ERROR", 5) == 0 && (mode & O_WRONLY) != 0)
166 file = stderr, name += 5;
167 if (*name == ':') name++; /* treat trailing colon as optional */
168 }
169 /* note: VAXCRTL stdio has extra level of indirection (*file) */
170 return (file && *file && *name == '\0') ? fileno(file) : -1;
171 }
172
173
174 #define VMS_UNITS_PER_SECOND 10000000L /* hundreds of nanoseconds, 1e-7 */
175 #define UNIX_EPOCH "01-JAN-1970 00:00:00.00"
176
177 extern U_Long SYS$BINTIM(), SYS$GETTIM();
178 extern U_Long LIB$SUBX(), LIB$EDIV();
179
180 /*
181 * Get current time in microsecond precision.
182 */
183 /* vms_gettimeofday() - get current time in `struct timeval' format */
184 int
185 vms_gettimeofday(struct timeval *tv, void *timezone__not_used)
186 {
187 /*
188 Emulate unix's gettimeofday call; timezone argument is ignored.
189 */
190 static const struct dsc$descriptor_s epoch_dsc =
191 { sizeof UNIX_EPOCH - sizeof "",
192 DSC$K_DTYPE_T, DSC$K_CLASS_S, UNIX_EPOCH };
193 static long epoch[2] = {0L,0L}; /* needs one time initialization */
194 const long thunk = VMS_UNITS_PER_SECOND;
195 long now[2], quad[2];
196
197 if (!epoch[0]) SYS$BINTIM(&epoch_dsc, epoch); /* 1 Jan 0:0:0 1970 */
198 /* get current time, as VMS quadword time */
199 SYS$GETTIM(now);
200 /* convert the quadword time so that it's relative to Unix epoch */
201 LIB$SUBX(now, epoch, quad); /* quad = now - epoch; */
202 /* convert 1e-7 units into seconds and fraction of seconds */
203 LIB$EDIV(&thunk, quad, &tv->tv_sec, &tv->tv_usec);
204 /* convert fraction of seconds into microseconds */
205 tv->tv_usec /= (VMS_UNITS_PER_SECOND / 1000000);
206
207 return 0; /* success */
208 }
209
210
211 #ifndef VMS_V7
212 /*
213 * VMS prior to V7.x has no timezone support unless DECnet/OSI is used.
214 */
215 /* these are global for use by missing/strftime.c */
216 char *tzname[2] = { "local", "" };
217 int daylight = 0, timezone = 0, altzone = 0;
218
219 /* tzset() -- dummy to satisfy linker */
220 void tzset(void)
221 {
222 return;
223 }
224 #endif /*VMS_V7*/
225
226
227 #ifndef CRTL_VER_V731
228 /* getpgrp() -- there's no such thing as process group under VMS;
229 * job tree might be close enough to be useful though.
230 */
231 int getpgrp(void)
232 {
233 return 0;
234 }
235 #endif
236
237 #ifndef __GNUC__
238 void vms_bcopy( const char *src, char *dst, int len )
239 {
240 (void) memcpy(dst, src, len);
241 }
242 #endif /*!__GNUC__*/
243
244
245 /*----------------------------------------------------------------------*/
246 #ifdef NO_VMS_ARGS /* real code is in "vms/vms_args.c" */
247 void vms_arg_fixup( int *argc, char ***argv ) { return; } /* dummy */
248 #endif
249
250 #ifdef NO_VMS_PIPES /* real code is in "vms/vms_popen.c" */
251 FILE *popen( const char *command, const char *mode ) {
252 fatal(" Cannot open pipe `%s' (not implemented)", command);
253 return NULL;
254 }
255 int pclose( FILE *current ) {
256 fatal(" Cannot close pipe #%d (not implemented)", fileno(current));
257 return -1;
258 }
259 int fork( void ) {
260 fatal(" Cannot fork process (not implemented)");
261 return -1;
262 }
263 #endif /*NO_VMS_PIPES*/
264 /*----------------------------------------------------------------------*/
265
266
267 /*
268 * The following code is taken from the GNU C preprocessor (cccp.c,
269 * 2.8.1 vintage) where it was used #if VMS. It is only needed for
270 * VAX C and GNU C on VAX configurations; DEC C's run-time library
271 * doesn't have the problem described.
272 *
273 * VMS_fstat() and VMS_stat() were static in cccp.c but need to be
274 * accessible to the whole program here. Also, the special handling
275 * for the null device has been introduced for gawk's benefit, to
276 * prevent --lint mode from giving spurious warnings about /dev/null
277 * being empty if it's used as an input file.
278 */
279
280 #if defined(VAXC) || (defined(__GNUC__) && !defined(__alpha))
281
282 /* more VMS hackery */
283 #include <fab.h>
284 #include <nam.h>
285
286 extern unsigned long SYS$PARSE(), SYS$SEARCH();
287
288 /* Work around a VAXCRTL bug. If a file is located via a searchlist,
289 and if the device it's on is not the same device as the one specified
290 in the first element of that searchlist, then both stat() and fstat()
291 will fail to return info about it. `errno' will be set to EVMSERR, and
292 `vaxc$errno' will be set to SS$_NORMAL due yet another bug in stat()!
293 We can get around this by fully parsing the filename and then passing
294 that absolute name to stat().
295
296 Without this fix, we can end up failing to find header files, which is
297 bad enough, but then compounding the problem by reporting the reason for
298 failure as "normal successful completion." */
299
300 #undef fstat /* Get back to the library version. */
301
302 int
303 VMS_fstat (fd, statbuf)
304 int fd;
305 struct stat *statbuf;
306 {
307 int result = fstat (fd, statbuf);
308
309 if (result < 0)
310 {
311 FILE *fp;
312 char nambuf[NAM$C_MAXRSS+1];
313
314 if ((fp = fdopen (fd, "r")) != 0 && fgetname (fp, nambuf) != 0)
315 result = VMS_stat (nambuf, statbuf);
316 /* No fclose(fp) here; that would close(fd) as well. */
317 }
318
319 if (result == 0 /* GAWK addition; fixup /dev/null flags */
320 && (statbuf->st_mode & S_IFREG)
321 && strcmp(statbuf->st_dev, "_NLA0:") == 0)
322 {
323 statbuf->st_mode &= ~S_IFREG;
324 statbuf->st_mode |= S_IFCHR;
325 }
326
327 return result;
328 }
329
330 int
331 VMS_stat (name, statbuf)
332 const char *name;
333 struct stat *statbuf;
334 {
335 int result = stat (name, statbuf);
336
337 if (result < 0)
338 {
339 struct FAB fab;
340 struct NAM nam;
341 char exp_nam[NAM$C_MAXRSS+1], /* expanded name buffer for sys$parse */
342 res_nam[NAM$C_MAXRSS+1]; /* resultant name buffer for sys$search */
343
344 fab = cc$rms_fab;
345 fab.fab$l_fna = (char *) name;
346 fab.fab$b_fns = (unsigned char) strlen (name);
347 fab.fab$l_nam = (void *) &nam;
348 nam = cc$rms_nam;
349 nam.nam$l_esa = exp_nam, nam.nam$b_ess = sizeof exp_nam - 1;
350 nam.nam$l_rsa = res_nam, nam.nam$b_rss = sizeof res_nam - 1;
351 nam.nam$b_nop = NAM$M_PWD | NAM$M_NOCONCEAL;
352 if (sys$parse (&fab) & 1)
353 {
354 if (sys$search (&fab) & 1)
355 {
356 res_nam[nam.nam$b_rsl] = '\0';
357 result = stat (res_nam, statbuf);
358 }
359 /* Clean up searchlist context cached by the system. */
360 nam.nam$b_nop = NAM$M_SYNCHK;
361 fab.fab$l_fna = 0, fab.fab$b_fns = 0;
362 (void) sys$parse (&fab);
363 }
364 }
365
366 if (result == 0 /* GAWK addition; fixup /dev/null flags */
367 && (statbuf->st_mode & S_IFREG)
368 && strcmp(statbuf->st_dev, "_NLA0:") == 0)
369 {
370 statbuf->st_mode &= ~S_IFREG;
371 statbuf->st_mode |= S_IFCHR;
372 }
373
374 return result;
375 }
376 #endif /* VAXC || (__GNUC__ && !__alpha) */