Commit | Line | Data |
---|---|---|
2ae00b68 | 1 | /* VMS::Stdio - VMS extensions to stdio routines |
748a9306 | 2 | * |
562a7b0c | 3 | * Author: Charles Bailey bailey@newman.upenn.edu |
748a9306 | 4 | * |
748a9306 LW |
5 | */ |
6 | ||
7 | #include "EXTERN.h" | |
8 | #include "perl.h" | |
9 | #include "XSUB.h" | |
2ae00b68 | 10 | #include <file.h> |
17f28c40 CB |
11 | #include <iodef.h> |
12 | #include <rms.h> | |
13 | #include <starlet.h> | |
2ae00b68 | 14 | |
15 | static bool | |
b626ecd9 | 16 | constant(char *name, IV *pval) |
2ae00b68 | 17 | { |
18 | if (strnNE(name, "O_", 2)) return FALSE; | |
19 | ||
20 | if (strEQ(name, "O_APPEND")) | |
21 | #ifdef O_APPEND | |
22 | { *pval = O_APPEND; return TRUE; } | |
23 | #else | |
24 | return FALSE; | |
25 | #endif | |
26 | if (strEQ(name, "O_CREAT")) | |
27 | #ifdef O_CREAT | |
28 | { *pval = O_CREAT; return TRUE; } | |
29 | #else | |
30 | return FALSE; | |
31 | #endif | |
32 | if (strEQ(name, "O_EXCL")) | |
33 | #ifdef O_EXCL | |
34 | { *pval = O_EXCL; return TRUE; } | |
35 | #else | |
36 | return FALSE; | |
37 | #endif | |
38 | if (strEQ(name, "O_NDELAY")) | |
39 | #ifdef O_NDELAY | |
40 | { *pval = O_NDELAY; return TRUE; } | |
41 | #else | |
42 | return FALSE; | |
43 | #endif | |
44 | if (strEQ(name, "O_NOWAIT")) | |
45 | #ifdef O_NOWAIT | |
46 | { *pval = O_NOWAIT; return TRUE; } | |
47 | #else | |
48 | return FALSE; | |
49 | #endif | |
50 | if (strEQ(name, "O_RDONLY")) | |
51 | #ifdef O_RDONLY | |
52 | { *pval = O_RDONLY; return TRUE; } | |
53 | #else | |
54 | return FALSE; | |
55 | #endif | |
56 | if (strEQ(name, "O_RDWR")) | |
57 | #ifdef O_RDWR | |
58 | { *pval = O_RDWR; return TRUE; } | |
59 | #else | |
60 | return FALSE; | |
61 | #endif | |
62 | if (strEQ(name, "O_TRUNC")) | |
63 | #ifdef O_TRUNC | |
64 | { *pval = O_TRUNC; return TRUE; } | |
65 | #else | |
66 | return FALSE; | |
67 | #endif | |
68 | if (strEQ(name, "O_WRONLY")) | |
69 | #ifdef O_WRONLY | |
70 | { *pval = O_WRONLY; return TRUE; } | |
71 | #else | |
72 | return FALSE; | |
73 | #endif | |
74 | ||
75 | return FALSE; | |
76 | } | |
748a9306 | 77 | |
748a9306 | 78 | |
2ae00b68 | 79 | static SV * |
a15cef0c | 80 | newFH(PerlIO *fp, char type) { |
55497cff | 81 | SV *rv; |
561b68a9 | 82 | GV **stashp, *gv = (GV *)newSV(0); |
2ae00b68 | 83 | HV *stash; |
84 | IO *io; | |
85 | ||
86 | /* Find stash for VMS::Stdio. We don't do this once at boot | |
87 | * to allow for possibility of threaded Perl with per-thread | |
88 | * symbol tables. This code (through io = ...) is really | |
89 | * equivalent to gv_fetchpv("VMS::Stdio::__FH__",TRUE,SVt_PVIO), | |
90 | * with a little less overhead, and good exercise for me. :-) */ | |
6b88bc9c | 91 | stashp = (GV **)hv_fetch(PL_defstash,"VMS::",5,TRUE); |
4e205ed6 | 92 | if (!stashp || *stashp == (GV *)&PL_sv_undef) return NULL; |
2ae00b68 | 93 | if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV(); |
94 | stashp = (GV **)hv_fetch(GvHV(*stashp),"Stdio::",7,TRUE); | |
4e205ed6 | 95 | if (!stashp || *stashp == (GV *)&PL_sv_undef) return NULL; |
2ae00b68 | 96 | if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV(); |
97 | ||
98 | /* Set up GV to point to IO, and then take reference */ | |
99 | gv_init(gv,stash,"__FH__",6,0); | |
100 | io = GvIOp(gv) = newIO(); | |
101 | IoIFP(io) = fp; | |
5f05dabc | 102 | if (type != '<') IoOFP(io) = fp; |
2ae00b68 | 103 | IoTYPE(io) = type; |
55497cff | 104 | rv = newRV((SV *)gv); |
2ae00b68 | 105 | SvREFCNT_dec(gv); |
106 | return sv_bless(rv,stash); | |
107 | } | |
108 | ||
109 | MODULE = VMS::Stdio PACKAGE = VMS::Stdio | |
748a9306 LW |
110 | |
111 | void | |
2ae00b68 | 112 | constant(name) |
748a9306 | 113 | char * name |
2ae00b68 | 114 | PROTOTYPE: $ |
115 | CODE: | |
116 | IV i; | |
117 | if (constant(name, &i)) | |
118 | ST(0) = sv_2mortal(newSViv(i)); | |
119 | else | |
6b88bc9c | 120 | ST(0) = &PL_sv_undef; |
2ae00b68 | 121 | |
122 | void | |
562a7b0c CB |
123 | binmode(fh) |
124 | SV * fh | |
125 | PROTOTYPE: $ | |
126 | CODE: | |
493ba88a PP |
127 | SV *name; |
128 | IO *io; | |
129 | char iotype; | |
4e205ed6 | 130 | char filespec[NAM$C_MAXRSS], *acmode, *s, *colon, *dirend = NULL; |
493ba88a | 131 | int ret = 0, saverrno = errno, savevmserrno = vaxc$errno; |
a15cef0c | 132 | SV pos; |
493ba88a PP |
133 | PerlIO *fp; |
134 | io = sv_2io(fh); | |
135 | fp = io ? IoOFP(io) : NULL; | |
136 | iotype = io ? IoTYPE(io) : '\0'; | |
4e205ed6 | 137 | if (fp == NULL || strchr(">was+-|",iotype) == NULL) { |
562a7b0c CB |
138 | set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF; |
139 | } | |
a15cef0c | 140 | if (!PerlIO_getname(fp,filespec)) XSRETURN_UNDEF; |
562a7b0c CB |
141 | for (s = filespec; *s; s++) { |
142 | if (*s == ':') colon = s; | |
143 | else if (*s == ']' || *s == '>') dirend = s; | |
144 | } | |
145 | /* Looks like a tmpfile, which will go away if reopened */ | |
146 | if (s == dirend + 3) { | |
147 | set_errno(EBADF); set_vaxc_errno(RMS$_IOP); XSRETURN_UNDEF; | |
148 | } | |
149 | /* If we've got a non-file-structured device, clip off the trailing | |
150 | * junk, and don't lose sleep if we can't get a stream position. */ | |
4e205ed6 | 151 | if (dirend == NULL) *(colon+1) = '\0'; |
a15cef0c | 152 | if (iotype != '-' && (ret = PerlIO_getpos(fp, &pos)) == -1 && dirend) |
562a7b0c CB |
153 | XSRETURN_UNDEF; |
154 | switch (iotype) { | |
155 | case '<': case 'r': acmode = "rb"; break; | |
156 | case '>': case 'w': case '|': | |
157 | /* use 'a' instead of 'w' to avoid creating new file; | |
158 | fsetpos below will take care of restoring file position */ | |
159 | case 'a': acmode = "ab"; break; | |
160 | case '+': case 's': acmode = "rb+"; break; | |
a15cef0c | 161 | case '-': acmode = PerlIO_fileno(fp) ? "ab" : "rb"; break; |
562a7b0c CB |
162 | /* iotype'll be null for the SYS$INPUT:/SYS$OUTPUT:/SYS$ERROR: files */ |
163 | /* since we didn't really open them and can't really */ | |
164 | /* reopen them */ | |
165 | case 0: XSRETURN_UNDEF; | |
166 | default: | |
167 | if (PL_dowarn) warn("Unrecognized iotype %c for %s in binmode", | |
168 | iotype, filespec); | |
169 | acmode = "rb+"; | |
170 | } | |
a15cef0c | 171 | /* appearances to the contrary, this is an freopen substitute */ |
493ba88a | 172 | name = sv_2mortal(newSVpvn(filespec,strlen(filespec))); |
4e205ed6 | 173 | if (PerlIO_openn(aTHX_ NULL,acmode,-1,0,0,fp,1,&name) == NULL) XSRETURN_UNDEF; |
a15cef0c | 174 | if (iotype != '-' && ret != -1 && PerlIO_setpos(fp,&pos) == -1) XSRETURN_UNDEF; |
562a7b0c CB |
175 | if (ret == -1) { set_errno(saverrno); set_vaxc_errno(savevmserrno); } |
176 | XSRETURN_YES; | |
177 | ||
178 | ||
179 | void | |
17f28c40 | 180 | flush(fp) |
a15cef0c | 181 | PerlIO * fp |
2ae00b68 | 182 | PROTOTYPE: $ |
183 | CODE: | |
a15cef0c CB |
184 | FILE *stdio = PerlIO_exportFILE(fp,0); |
185 | if (fflush(stdio)) { ST(0) = &PL_sv_undef; } | |
186 | else { clearerr(stdio); ST(0) = &PL_sv_yes; } | |
187 | PerlIO_releaseFILE(fp,stdio); | |
2ae00b68 | 188 | |
189 | char * | |
190 | getname(fp) | |
7f8ddb16 | 191 | PerlIO * fp |
2ae00b68 | 192 | PROTOTYPE: $ |
193 | CODE: | |
7f8ddb16 | 194 | FILE *stdio = PerlIO_exportFILE(fp,0); |
17f28c40 | 195 | char fname[NAM$C_MAXRSS+1]; |
2ae00b68 | 196 | ST(0) = sv_newmortal(); |
7f8ddb16 | 197 | if (fgetname(stdio,fname) != NULL) sv_setpv(ST(0),fname); |
b89086ac | 198 | PerlIO_releaseFILE(fp,stdio); |
2ae00b68 | 199 | |
200 | void | |
201 | rewind(fp) | |
a15cef0c | 202 | PerlIO * fp |
2ae00b68 | 203 | PROTOTYPE: $ |
204 | CODE: | |
a15cef0c CB |
205 | FILE *stdio = PerlIO_exportFILE(fp,0); |
206 | ST(0) = rewind(stdio) ? &PL_sv_undef : &PL_sv_yes; | |
207 | PerlIO_releaseFILE(fp,stdio); | |
2ae00b68 | 208 | |
209 | void | |
210 | remove(name) | |
211 | char *name | |
212 | PROTOTYPE: $ | |
213 | CODE: | |
6b88bc9c | 214 | ST(0) = remove(name) ? &PL_sv_undef : &PL_sv_yes; |
2ae00b68 | 215 | |
216 | void | |
17f28c40 CB |
217 | setdef(...) |
218 | PROTOTYPE: @ | |
219 | CODE: | |
220 | char vmsdef[NAM$C_MAXRSS+1], es[NAM$C_MAXRSS], sep; | |
221 | unsigned long int retsts; | |
222 | struct FAB deffab = cc$rms_fab; | |
223 | struct NAM defnam = cc$rms_nam; | |
224 | struct dsc$descriptor_s dirdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; | |
2d8e6c8d | 225 | STRLEN n_a; |
17f28c40 CB |
226 | if (items) { |
227 | SV *defsv = ST(items-1); /* mimic chdir() */ | |
6b88bc9c | 228 | ST(0) = &PL_sv_undef; |
17f28c40 | 229 | if (!SvPOK(defsv)) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN(1); } |
2d8e6c8d | 230 | if (tovmsspec(SvPV(defsv,n_a),vmsdef) == NULL) { XSRETURN(1); } |
17f28c40 CB |
231 | deffab.fab$l_fna = vmsdef; deffab.fab$b_fns = strlen(vmsdef); |
232 | } | |
233 | else { | |
234 | deffab.fab$l_fna = "SYS$LOGIN"; deffab.fab$b_fns = 9; | |
6b88bc9c | 235 | EXTEND(sp,1); ST(0) = &PL_sv_undef; |
17f28c40 CB |
236 | } |
237 | defnam.nam$l_esa = es; defnam.nam$b_ess = sizeof es; | |
238 | deffab.fab$l_nam = &defnam; | |
239 | retsts = sys$parse(&deffab,0,0); | |
240 | if (retsts & 1) { | |
241 | if (defnam.nam$v_wildcard) retsts = RMS$_WLD; | |
242 | else if (defnam.nam$b_name || defnam.nam$b_type > 1 || | |
243 | defnam.nam$b_ver > 1) retsts = RMS$_DIR; | |
244 | } | |
245 | defnam.nam$b_nop |= NAM$M_SYNCHK; defnam.nam$l_rlf = NULL; deffab.fab$b_dns = 0; | |
246 | if (!(retsts & 1)) { | |
247 | set_vaxc_errno(retsts); | |
248 | switch (retsts) { | |
249 | case RMS$_DNF: | |
250 | set_errno(ENOENT); break; | |
251 | case RMS$_SYN: case RMS$_DIR: case RMS$_DEV: | |
252 | set_errno(EINVAL); break; | |
253 | case RMS$_PRV: | |
254 | set_errno(EACCES); break; | |
255 | default: | |
256 | set_errno(EVMSERR); break; | |
257 | } | |
258 | (void) sys$parse(&deffab,0,0); /* free up context */ | |
259 | XSRETURN(1); | |
260 | } | |
261 | sep = *defnam.nam$l_dir; | |
262 | *defnam.nam$l_dir = '\0'; | |
263 | my_setenv("SYS$DISK",defnam.nam$b_node ? defnam.nam$l_node : defnam.nam$l_dev); | |
264 | *defnam.nam$l_dir = sep; | |
265 | dirdsc.dsc$a_pointer = defnam.nam$l_dir; dirdsc.dsc$w_length = defnam.nam$b_dir; | |
6b88bc9c | 266 | if ((retsts = sys$setddir(&dirdsc,0,0)) & 1) ST(0) = &PL_sv_yes; |
17f28c40 CB |
267 | else { set_errno(EVMSERR); set_vaxc_errno(retsts); } |
268 | (void) sys$parse(&deffab,0,0); /* free up context */ | |
269 | ||
270 | void | |
2ae00b68 | 271 | sync(fp) |
a15cef0c | 272 | PerlIO * fp |
2ae00b68 | 273 | PROTOTYPE: $ |
274 | CODE: | |
a15cef0c CB |
275 | FILE *stdio = PerlIO_exportFILE(fp,0); |
276 | if (fsync(fileno(stdio))) { ST(0) = &PL_sv_undef; } | |
277 | else { clearerr(stdio); ST(0) = &PL_sv_yes; } | |
278 | PerlIO_releaseFILE(fp,stdio); | |
2ae00b68 | 279 | |
280 | char * | |
281 | tmpnam() | |
282 | PROTOTYPE: | |
283 | CODE: | |
284 | char fname[L_tmpnam]; | |
285 | ST(0) = sv_newmortal(); | |
286 | if (tmpnam(fname) != NULL) sv_setpv(ST(0),fname); | |
287 | ||
288 | void | |
289 | vmsopen(spec,...) | |
290 | char * spec | |
291 | PROTOTYPE: @ | |
748a9306 | 292 | CODE: |
2ae00b68 | 293 | char *args[8],mode[3] = {'r','\0','\0'}, type = '<'; |
5aaab254 | 294 | int i, myargc; |
748a9306 | 295 | FILE *fp; |
493ba88a | 296 | SV *fh; |
a15cef0c | 297 | PerlIO *pio_fp; |
2d8e6c8d | 298 | STRLEN n_a; |
2ae00b68 | 299 | |
300 | if (!spec || !*spec) { | |
301 | SETERRNO(EINVAL,LIB$_INVARG); | |
302 | XSRETURN_UNDEF; | |
748a9306 | 303 | } |
2ae00b68 | 304 | if (items > 9) croak("too many args"); |
305 | ||
748a9306 | 306 | /* First, set up name and mode args from perl's string */ |
2ae00b68 | 307 | if (*spec == '+') { |
748a9306 | 308 | mode[1] = '+'; |
2ae00b68 | 309 | spec++; |
748a9306 | 310 | } |
2ae00b68 | 311 | if (*spec == '>') { |
312 | if (*(spec+1) == '>') *mode = 'a', spec += 2; | |
313 | else *mode = 'w', spec++; | |
748a9306 | 314 | } |
2ae00b68 | 315 | else if (*spec == '<') spec++; |
748a9306 | 316 | myargc = items - 1; |
2d8e6c8d | 317 | for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),n_a); |
748a9306 LW |
318 | /* This hack brought to you by C's opaque arglist management */ |
319 | switch (myargc) { | |
320 | case 0: | |
2ae00b68 | 321 | fp = fopen(spec,mode); |
748a9306 LW |
322 | break; |
323 | case 1: | |
2ae00b68 | 324 | fp = fopen(spec,mode,args[0]); |
748a9306 LW |
325 | break; |
326 | case 2: | |
2ae00b68 | 327 | fp = fopen(spec,mode,args[0],args[1]); |
748a9306 LW |
328 | break; |
329 | case 3: | |
2ae00b68 | 330 | fp = fopen(spec,mode,args[0],args[1],args[2]); |
748a9306 LW |
331 | break; |
332 | case 4: | |
2ae00b68 | 333 | fp = fopen(spec,mode,args[0],args[1],args[2],args[3]); |
748a9306 LW |
334 | break; |
335 | case 5: | |
2ae00b68 | 336 | fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4]); |
748a9306 LW |
337 | break; |
338 | case 6: | |
2ae00b68 | 339 | fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4],args[5]); |
748a9306 LW |
340 | break; |
341 | case 7: | |
2ae00b68 | 342 | fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6]); |
748a9306 LW |
343 | break; |
344 | case 8: | |
2ae00b68 | 345 | fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6],args[7]); |
748a9306 LW |
346 | break; |
347 | } | |
b9893e57 | 348 | if (fp != NULL) { |
7f8ddb16 | 349 | pio_fp = PerlIO_fdopen(fileno(fp),mode); |
493ba88a PP |
350 | fh = newFH(pio_fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : (mode[0] == 'a' ? 'a' : '>')))); |
351 | ST(0) = (fh ? sv_2mortal(fh) : &PL_sv_undef); | |
748a9306 | 352 | } |
6b88bc9c | 353 | else { ST(0) = &PL_sv_undef; } |
748a9306 | 354 | |
2ae00b68 | 355 | void |
356 | vmssysopen(spec,mode,perm,...) | |
357 | char * spec | |
358 | int mode | |
359 | int perm | |
360 | PROTOTYPE: @ | |
748a9306 | 361 | CODE: |
2ae00b68 | 362 | char *args[8]; |
363 | int i, myargc, fd; | |
7f8ddb16 | 364 | PerlIO *pio_fp; |
2ae00b68 | 365 | SV *fh; |
2d8e6c8d | 366 | STRLEN n_a; |
2ae00b68 | 367 | if (!spec || !*spec) { |
368 | SETERRNO(EINVAL,LIB$_INVARG); | |
369 | XSRETURN_UNDEF; | |
370 | } | |
371 | if (items > 11) croak("too many args"); | |
372 | myargc = items - 3; | |
2d8e6c8d | 373 | for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),n_a); |
2ae00b68 | 374 | /* More fun with C calls; can't combine with above because |
375 | args 2,3 of different types in fopen() and open() */ | |
376 | switch (myargc) { | |
377 | case 0: | |
378 | fd = open(spec,mode,perm); | |
379 | break; | |
380 | case 1: | |
381 | fd = open(spec,mode,perm,args[0]); | |
382 | break; | |
383 | case 2: | |
384 | fd = open(spec,mode,perm,args[0],args[1]); | |
385 | break; | |
386 | case 3: | |
387 | fd = open(spec,mode,perm,args[0],args[1],args[2]); | |
388 | break; | |
389 | case 4: | |
390 | fd = open(spec,mode,perm,args[0],args[1],args[2],args[3]); | |
391 | break; | |
392 | case 5: | |
393 | fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4]); | |
394 | break; | |
395 | case 6: | |
396 | fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4],args[5]); | |
397 | break; | |
398 | case 7: | |
399 | fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4],args[5],args[6]); | |
400 | break; | |
401 | case 8: | |
402 | fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4],args[5],args[6],args[7]); | |
403 | break; | |
404 | } | |
405 | i = mode & 3; | |
406 | if (fd >= 0 && | |
4e205ed6 | 407 | ((pio_fp = PerlIO_fdopen(fd, &("r\000w\000r+"[2*i]))) != NULL)) { |
493ba88a PP |
408 | fh = newFH(pio_fp,"<>++"[i]); |
409 | ST(0) = (fh ? sv_2mortal(fh) : &PL_sv_undef); | |
2ae00b68 | 410 | } |
6b88bc9c | 411 | else { ST(0) = &PL_sv_undef; } |
748a9306 | 412 | |
2ae00b68 | 413 | void |
414 | waitfh(fp) | |
a15cef0c | 415 | PerlIO * fp |
2ae00b68 | 416 | PROTOTYPE: $ |
748a9306 | 417 | CODE: |
a15cef0c CB |
418 | FILE *stdio = PerlIO_exportFILE(fp,0); |
419 | ST(0) = fwait(stdio) ? &PL_sv_undef : &PL_sv_yes; | |
420 | PerlIO_releaseFILE(fp,stdio); | |
17f28c40 CB |
421 | |
422 | void | |
423 | writeof(mysv) | |
424 | SV * mysv | |
425 | PROTOTYPE: $ | |
426 | CODE: | |
427 | char devnam[257], *cp; | |
428 | unsigned long int chan, iosb[2], retsts, retsts2; | |
429 | struct dsc$descriptor devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, devnam}; | |
430 | IO *io = sv_2io(mysv); | |
a15cef0c | 431 | PerlIO *fp = io ? IoOFP(io) : NULL; |
4e205ed6 | 432 | if (fp == NULL || strchr(">was+-|",IoTYPE(io)) == NULL) { |
562a7b0c | 433 | set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF; |
17f28c40 | 434 | } |
4e205ed6 | 435 | if (PerlIO_getname(fp,devnam) == NULL) { ST(0) = &PL_sv_undef; XSRETURN(1); } |
17f28c40 CB |
436 | if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0'; |
437 | devdsc.dsc$w_length = strlen(devnam); | |
438 | retsts = sys$assign(&devdsc,&chan,0,0); | |
439 | if (retsts & 1) retsts = sys$qiow(0,chan,IO$_WRITEOF,iosb,0,0,0,0,0,0,0,0); | |
440 | if (retsts & 1) retsts = iosb[0]; | |
441 | retsts2 = sys$dassgn(chan); /* Be sure to deassign the channel */ | |
442 | if (retsts & 1) retsts = retsts2; | |
6b88bc9c | 443 | if (retsts & 1) { ST(0) = &PL_sv_yes; } |
17f28c40 CB |
444 | else { |
445 | set_vaxc_errno(retsts); | |
446 | switch (retsts) { | |
447 | case SS$_EXQUOTA: case SS$_INSFMEM: case SS$_MBFULL: | |
448 | case SS$_MBTOOSML: case SS$_NOIOCHAN: case SS$_NOLINKS: | |
449 | case SS$_BUFFEROVF: | |
450 | set_errno(ENOSPC); break; | |
451 | case SS$_ILLIOFUNC: case SS$_DEVOFFLINE: case SS$_NOSUCHDEV: | |
452 | set_errno(EBADF); break; | |
453 | case SS$_NOPRIV: | |
454 | set_errno(EACCES); break; | |
455 | default: /* Includes "shouldn't happen" cases that might map */ | |
456 | set_errno(EVMSERR); break; /* to other errno values */ | |
457 | } | |
6b88bc9c | 458 | ST(0) = &PL_sv_undef; |
17f28c40 | 459 | } |