1 /*
2  * Copyright © 1988-2004 Keith Packard and Bart Massey.
3  * All Rights Reserved.  See the file COPYING in this directory
4  * for licensing information.
5  */
6 
7 #include	<unistd.h>
8 #include	<fcntl.h>
9 #include	<signal.h>
10 #include	<sys/time.h>
11 #include	<sys/types.h>
12 #include	<sys/wait.h>
13 #include	<errno.h>
14 #include	<sys/socket.h>
15 #include        <assert.h>
16 #include	"nickle.h"
17 #include	"ref.h"
18 #include	"gram.h"
19 
20 #ifdef O_ASYNC
21 #define ASYNC O_ASYNC
22 #else
23 #ifdef HAVE_STROPTS_H
24 #define USE_STREAMS_ASYNC
25 #define ASYNC 0
26 #include <stropts.h>
27 #endif
28 #endif
29 
30 ReferencePtr	fileBlockedReference;
31 Value		fileBlocked;
32 extern Bool	stdinOwned, stdinPolling;
33 #ifdef NO_PIPE_SIGIO
34 Bool		anyPipeReadBlocked;
35 #endif
36 extern Bool	ownTty[3];
37 
38 typedef struct _FileErrorMap {
39     int		value;
40     char	*name;
41     char	*message;
42 } FileErrorMap;
43 
44 #define EUTF8    -128
45 
46 const FileErrorMap   fileErrorMap[] = {
47 #ifdef EPERM
48     { EPERM, "PERM", "Operation not permitted" },
49 #endif
50 #ifdef ENOENT
51     { ENOENT, "NOENT", "No such file or directory" },
52 #endif
53 #ifdef ESRCH
54     { ESRCH, "SRCH", "No such process" },
55 #endif
56 #ifdef EINTR
57     { EINTR, "INTR", "Interrupted system call" },
58 #endif
59 #ifdef EIO
60     { EIO, "IO", "I/O error" },
61 #endif
62 #ifdef ENXIO
63     { ENXIO, "NXIO", "No such device or address" },
64 #endif
65 #ifdef E2BIG
66     { E2BIG, "2BIG", "Arg list too long" },
67 #endif
68 #ifdef ENOEXEC
69     { ENOEXEC, "NOEXEC", "Exec format error" },
70 #endif
71 #ifdef EBADF
72     { EBADF, "BADF", "Bad file number" },
73 #endif
74 #ifdef ECHILD
75     { ECHILD, "CHILD", "No child processes" },
76 #endif
77 #ifdef EAGAIN
78     { EAGAIN, "AGAIN", "Try again" },
79 #endif
80 #ifdef ENOMEM
81     { ENOMEM, "NOMEM", "Out of memory" },
82 #endif
83 #ifdef EACCES
84     { EACCES, "ACCES", "Permission denied" },
85 #endif
86 #ifdef EFAULT
87     { EFAULT, "FAULT", "Bad address" },
88 #endif
89 #ifdef ENOTBLK
90     { ENOTBLK, "NOTBLK", "Block device required" },
91 #endif
92 #ifdef EBUSY
93     { EBUSY, "BUSY", "Device or resource busy" },
94 #endif
95 #ifdef EEXIST
96     { EEXIST, "EXIST", "File exists" },
97 #endif
98 #ifdef EXDEV
99     { EXDEV, "XDEV", "Cross-device link" },
100 #endif
101 #ifdef ENODEV
102     { ENODEV, "NODEV", "No such device" },
103 #endif
104 #ifdef ENOTDIR
105     { ENOTDIR, "NOTDIR", "Not a directory" },
106 #endif
107 #ifdef EISDIR
108     { EISDIR, "ISDIR", "Is a directory" },
109 #endif
110 #ifdef EINVAL
111     { EINVAL, "INVAL", "Invalid argument" },
112 #endif
113 #ifdef ENFILE
114     { ENFILE, "NFILE", "File table overflow" },
115 #endif
116 #ifdef EMFILE
117     { EMFILE, "MFILE", "Too many open files" },
118 #endif
119 #ifdef ENOTTY
120     { ENOTTY, "NOTTY", "Not a typewriter" },
121 #endif
122 #ifdef ETXTBSY
123     { ETXTBSY, "TXTBSY", "Text file busy" },
124 #endif
125 #ifdef EFBIG
126     { EFBIG, "FBIG", "File too large" },
127 #endif
128 #ifdef ENOSPC
129     { ENOSPC, "NOSPC", "No space left on device" },
130 #endif
131 #ifdef ESPIPE
132     { ESPIPE, "SPIPE", "Illegal seek" },
133 #endif
134 #ifdef EROFS
135     { EROFS, "ROFS", "Read-only file system" },
136 #endif
137 #ifdef EMLINK
138     { EMLINK, "MLINK", "Too many links" },
139 #endif
140 #ifdef EPIPE
141     { EPIPE, "PIPE", "Broken pipe" },
142 #endif
143 #ifdef EDOM
144     { EDOM, "DOM", "Math argument out of domain of func" },
145 #endif
146 #ifdef ERANGE
147     { ERANGE, "RANGE", "Math result not representable" },
148 #endif
149 #ifdef EDEADLK
150     { EDEADLK, "DEADLK", "Resource deadlock would occur" },
151 #endif
152 #ifdef ENAMETOOLONG
153     { ENAMETOOLONG, "NAMETOOLONG", "File name too long" },
154 #endif
155 #ifdef ENOLCK
156     { ENOLCK, "NOLCK", "No record locks available" },
157 #endif
158 #ifdef ENOSYS
159     { ENOSYS, "NOSYS", "Function not implemented" },
160 #endif
161 #ifdef ENOTEMPTY
162     { ENOTEMPTY, "NOTEMPTY", "Directory not empty" },
163 #endif
164 #ifdef ELOOP
165     { ELOOP, "LOOP", "Too many symbolic links encountered" },
166 #endif
167 #ifdef EWOULDBLOCK
168     { EWOULDBLOCK, "WOULDBLOCK", "Operation would block" },
169 #endif
170 #ifdef ENOMSG
171     { ENOMSG, "NOMSG", "No message of desired type" },
172 #endif
173 #ifdef EIDRM
174     { EIDRM, "IDRM", "Identifier removed" },
175 #endif
176 #ifdef ECHRNG
177     { ECHRNG, "CHRNG", "Channel number out of range" },
178 #endif
179 #ifdef EL2NSYNC
180     { EL2NSYNC, "L2NSYNC", "Level 2 not synchronized" },
181 #endif
182 #ifdef EL3HLT
183     { EL3HLT, "L3HLT", "Level 3 halted" },
184 #endif
185 #ifdef EL3RST
186     { EL3RST, "L3RST", "Level 3 reset" },
187 #endif
188 #ifdef ELNRNG
189     { ELNRNG, "LNRNG", "Link number out of range" },
190 #endif
191 #ifdef EUNATCH
192     { EUNATCH, "UNATCH", "Protocol driver not attached" },
193 #endif
194 #ifdef ENOCSI
195     { ENOCSI, "NOCSI", "No CSI structure available" },
196 #endif
197 #ifdef EL2HLT
198     { EL2HLT, "L2HLT", "Level 2 halted" },
199 #endif
200 #ifdef EBADE
201     { EBADE, "BADE", "Invalid exchange" },
202 #endif
203 #ifdef EBADR
204     { EBADR, "BADR", "Invalid request descriptor" },
205 #endif
206 #ifdef EXFULL
207     { EXFULL, "XFULL", "Exchange full" },
208 #endif
209 #ifdef ENOANO
210     { ENOANO, "NOANO", "No anode" },
211 #endif
212 #ifdef EBADRQC
213     { EBADRQC, "BADRQC", "Invalid request code" },
214 #endif
215 #ifdef EBADSLT
216     { EBADSLT, "BADSLT", "Invalid slot" },
217 #endif
218 #ifdef EDEADLOCK
219     { EDEADLOCK, "DEADLOCK", "Resource deadlock would occur" },
220 #endif
221 #ifdef EBFONT
222     { EBFONT, "BFONT", "Bad font file format" },
223 #endif
224 #ifdef ENOSTR
225     { ENOSTR, "NOSTR", "Device not a stream" },
226 #endif
227 #ifdef ENODATA
228     { ENODATA, "NODATA", "No data available" },
229 #endif
230 #ifdef ETIME
231     { ETIME, "TIME", "Timer expired" },
232 #endif
233 #ifdef ENOSR
234     { ENOSR, "NOSR", "Out of streams resources" },
235 #endif
236 #ifdef ENONET
237     { ENONET, "NONET", "Machine is not on the network" },
238 #endif
239 #ifdef ENOPKG
240     { ENOPKG, "NOPKG", "Package not installed" },
241 #endif
242 #ifdef EREMOTE
243     { EREMOTE, "REMOTE", "Object is remote" },
244 #endif
245 #ifdef ENOLINK
246     { ENOLINK, "NOLINK", "Link has been severed" },
247 #endif
248 #ifdef EADV
249     { EADV, "ADV", "Advertise error" },
250 #endif
251 #ifdef ESRMNT
252     { ESRMNT, "SRMNT", "Srmount error" },
253 #endif
254 #ifdef ECOMM
255     { ECOMM, "COMM", "Communication error on send" },
256 #endif
257 #ifdef EPROTO
258     { EPROTO, "PROTO", "Protocol error" },
259 #endif
260 #ifdef EMULTIHOP
261     { EMULTIHOP, "MULTIHOP", "Multihop attempted" },
262 #endif
263 #ifdef EDOTDOT
264     { EDOTDOT, "DOTDOT", "RFS specific error" },
265 #endif
266 #ifdef EBADMSG
267     { EBADMSG, "BADMSG", "Not a data message" },
268 #endif
269 #ifdef EOVERFLOW
270     { EOVERFLOW, "OVERFLOW", "Value too large for defined data type" },
271 #endif
272 #ifdef ENOTUNIQ
273     { ENOTUNIQ, "NOTUNIQ", "Name not unique on network" },
274 #endif
275 #ifdef EBADFD
276     { EBADFD, "BADFD", "File descriptor in bad state" },
277 #endif
278 #ifdef EREMCHG
279     { EREMCHG, "REMCHG", "Remote address changed" },
280 #endif
281 #ifdef ELIBACC
282     { ELIBACC, "LIBACC", "Can not access a needed shared library" },
283 #endif
284 #ifdef ELIBBAD
285     { ELIBBAD, "LIBBAD", "Accessing a corrupted shared library" },
286 #endif
287 #ifdef ELIBSCN
288     { ELIBSCN, "LIBSCN", ".lib section in a.out corrupted" },
289 #endif
290 #ifdef ELIBMAX
291     { ELIBMAX, "LIBMAX", "Attempting to link in too many shared libraries" },
292 #endif
293 #ifdef ELIBEXEC
294     { ELIBEXEC, "LIBEXEC", "Cannot exec a shared library directly" },
295 #endif
296 #ifdef EILSEQ
297     { EILSEQ, "ILSEQ", "Illegal byte sequence" },
298 #endif
299 #ifdef ERESTART
300     { ERESTART, "RESTART", "Interrupted system call should be restarted" },
301 #endif
302 #ifdef ESTRPIPE
303     { ESTRPIPE, "STRPIPE", "Streams pipe error" },
304 #endif
305 #ifdef EUSERS
306     { EUSERS, "USERS", "Too many users" },
307 #endif
308 #ifdef ENOTSOCK
309     { ENOTSOCK, "NOTSOCK", "Socket operation on non-socket" },
310 #endif
311 #ifdef EDESTADDRREQ
312     { EDESTADDRREQ, "DESTADDRREQ", "Destination address required" },
313 #endif
314 #ifdef EMSGSIZE
315     { EMSGSIZE, "MSGSIZE", "Message too long" },
316 #endif
317 #ifdef EPROTOTYPE
318     { EPROTOTYPE, "PROTOTYPE", "Protocol wrong type for socket" },
319 #endif
320 #ifdef ENOPROTOOPT
321     { ENOPROTOOPT, "NOPROTOOPT", "Protocol not available" },
322 #endif
323 #ifdef EPROTONOSUPPORT
324     { EPROTONOSUPPORT, "PROTONOSUPPORT", "Protocol not supported" },
325 #endif
326 #ifdef ESOCKTNOSUPPORT
327     { ESOCKTNOSUPPORT, "SOCKTNOSUPPORT", "Socket type not supported" },
328 #endif
329 #ifdef EOPNOTSUPP
330     { EOPNOTSUPP, "OPNOTSUPP", "Operation not supported on transport endpoint" },
331 #endif
332 #ifdef EPFNOSUPPORT
333     { EPFNOSUPPORT, "PFNOSUPPORT", "Protocol family not supported" },
334 #endif
335 #ifdef EAFNOSUPPORT
336     { EAFNOSUPPORT, "AFNOSUPPORT", "Address family not supported by protocol" },
337 #endif
338 #ifdef EADDRINUSE
339     { EADDRINUSE, "ADDRINUSE", "Address already in use" },
340 #endif
341 #ifdef EADDRNOTAVAIL
342     { EADDRNOTAVAIL, "ADDRNOTAVAIL", "Cannot assign requested address" },
343 #endif
344 #ifdef ENETDOWN
345     { ENETDOWN, "NETDOWN", "Network is down" },
346 #endif
347 #ifdef ENETUNREACH
348     { ENETUNREACH, "NETUNREACH", "Network is unreachable" },
349 #endif
350 #ifdef ENETRESET
351     { ENETRESET, "NETRESET", "Network dropped connection because of reset" },
352 #endif
353 #ifdef ECONNABORTED
354     { ECONNABORTED, "CONNABORTED", "Software caused connection abort" },
355 #endif
356 #ifdef ECONNRESET
357     { ECONNRESET, "CONNRESET", "Connection reset by peer" },
358 #endif
359 #ifdef ENOBUFS
360     { ENOBUFS, "NOBUFS", "No buffer space available" },
361 #endif
362 #ifdef EISCONN
363     { EISCONN, "ISCONN", "Transport endpoint is already connected" },
364 #endif
365 #ifdef ENOTCONN
366     { ENOTCONN, "NOTCONN", "Transport endpoint is not connected" },
367 #endif
368 #ifdef ESHUTDOWN
369     { ESHUTDOWN, "SHUTDOWN", "Cannot send after transport endpoint shutdown" },
370 #endif
371 #ifdef ETOOMANYREFS
372     { ETOOMANYREFS, "TOOMANYREFS", "Too many references: cannot splice" },
373 #endif
374 #ifdef ETIMEDOUT
375     { ETIMEDOUT, "TIMEDOUT", "Connection timed out" },
376 #endif
377 #ifdef ECONNREFUSED
378     { ECONNREFUSED, "CONNREFUSED", "Connection refused" },
379 #endif
380 #ifdef EHOSTDOWN
381     { EHOSTDOWN, "HOSTDOWN", "Host is down" },
382 #endif
383 #ifdef EHOSTUNREACH
384     { EHOSTUNREACH, "HOSTUNREACH", "No route to host" },
385 #endif
386 #ifdef EALREADY
387     { EALREADY, "ALREADY", "Operation already in progress" },
388 #endif
389 #ifdef EINPROGRESS
390     { EINPROGRESS, "INPROGRESS", "Operation now in progress" },
391 #endif
392 #ifdef ESTALE
393     { ESTALE, "STALE", "Stale NFS file handle" },
394 #endif
395 #ifdef EUCLEAN
396     { EUCLEAN, "UCLEAN", "Structure needs cleaning" },
397 #endif
398 #ifdef ENOTNAM
399     { ENOTNAM, "NOTNAM", "Not a XENIX named type file" },
400 #endif
401 #ifdef ENAVAIL
402     { ENAVAIL, "NAVAIL", "No XENIX semaphores available" },
403 #endif
404 #ifdef EISNAM
405     { EISNAM, "ISNAM", "Is a named type file" },
406 #endif
407 #ifdef EREMOTEIO
408     { EREMOTEIO, "REMOTEIO", "Remote I/O error" },
409 #endif
410 #ifdef EDQUOT
411     { EDQUOT, "DQUOT", "Quota exceeded" },
412 #endif
413 #ifdef ENOMEDIUM
414     { ENOMEDIUM, "NOMEDIUM", "No medium found" },
415 #endif
416 #ifdef EMEDIUMTYPE
417     { EMEDIUMTYPE, "MEDIUMTYPE", "Wrong medium type" },
418 #endif
419 #ifdef EUTF8
420     { EUTF8, "UTF8", "Invalid UTF-8 byte sequence" },
421 #endif
422 };
423 
424 #define NUM_FILE_ERRORS	(sizeof (fileErrorMap) / sizeof (fileErrorMap[0]))
425 
426 Type    *typeFileError;
427 
428 static int
FileInitErrors(void)429 FileInitErrors (void)
430 {
431     ENTER ();
432     StructType	    *st;
433     Atom	    *atoms;
434     int		    i;
435     SymbolPtr	    error_type;
436 
437     error_type = NewSymbolType (AtomId("error_type"), 0);
438     st = NewStructType (NUM_FILE_ERRORS);
439     atoms = StructTypeAtoms (st);
440     for (i = 0; i < NUM_FILE_ERRORS; i++)
441     {
442 	AddBoxType (&st->types, typePrim[rep_void]);
443 	atoms[i] = AtomId (fileErrorMap[i].name);
444     }
445     error_type->symbol.type = NewTypeUnion (st, True);
446     typeFileError = NewTypeName (NewExprAtom (AtomId ("error_type"), 0, False),
447 				 error_type);
448     MemAddRoot (typeFileError);
449     EXIT ();
450     return 1;
451 }
452 
453 volatile Bool	signalChild;
454 
455 static void
sigchld(int sig)456 sigchld (int sig)
457 {
458     resetSignal (SIGCHLD, sigchld);
459     SetSignalChild ();
460 }
461 
462 void
ProcessInterrupt()463 ProcessInterrupt ()
464 {
465     for (;;) {
466 	pid_t		pid;
467 	int		status;
468 
469 	pid = wait3 (&status, WNOHANG, NULL);
470 	if (pid == 0)
471 	    break;
472 	if (pid < 0 && errno == ECHILD)
473 	    break;
474     }
475 }
476 
477 static FileChainPtr
FileChainAlloc(FileChainPtr next,int size)478 FileChainAlloc (FileChainPtr next, int size)
479 {
480     FileChainPtr	ret;
481 
482     ret = malloc (sizeof (FileChain) + size);
483     ret->next = next;
484     ret->size = size;
485     ret->used = 0;
486     ret->ptr = 0;
487     return ret;
488 }
489 
490 static void
FileChainFree(FileChainPtr ic)491 FileChainFree (FileChainPtr ic)
492 {
493     while (ic)
494     {
495 	FileChainPtr next = ic->next;
496 	free (ic);
497 	ic = next;
498     }
499 }
500 
501 int
FileInit(void)502 FileInit (void)
503 {
504     ENTER ();
505     catchSignal (SIGCHLD, sigchld);
506     fileBlockedReference = NewReference ((void **) &fileBlocked);
507     MemAddRoot (fileBlockedReference);
508     FileInitErrors ();
509     EXIT ();
510     return 1;
511 }
512 
513 Value
FileGetError(int err)514 FileGetError (int err)
515 {
516     ENTER();
517     Value	    ret;
518     int		    i;
519     StructType	    *st;
520 
521     for (i = 0; i < NUM_FILE_ERRORS; i++)
522 	if (fileErrorMap[i].value == err)
523 	    break;
524     if (i == NUM_FILE_ERRORS)
525 	i = 0;	    /* XXX weird error */
526     st = TypeCanon (typeFileError)->structs.structs;
527     ret = NewUnion (st, True);
528     ret->unions.tag = StructTypeAtoms(st)[i];
529     BoxValueSet (ret->unions.value,0,Void);
530     RETURN (ret);
531 }
532 
533 Value
FileGetErrorMessage(int err)534 FileGetErrorMessage (int err)
535 {
536     int i;
537     for (i = 0; i < NUM_FILE_ERRORS; i++)
538 	if (fileErrorMap[i].value == err)
539 	    return NewStrString (fileErrorMap[i].message);
540     return NewStrString ("Unknown error");
541 }
542 
543 static void
FileMark(void * object)544 FileMark (void *object)
545 {
546     File    *file = object;
547 
548     FileFlush ((Value) file, False);
549     MemReference (file->next);
550 }
551 
552 void
FileFini(void)553 FileFini (void)
554 {
555     MemCollect ();
556     while (anyFileWriteBlocked)
557 	FileCheckBlocked (True);
558 }
559 
560 static int
FileFree(void * object)561 FileFree (void *object)
562 {
563     File    *file = object;
564 
565     if (file->fd == -1 || FileClose ((Value) file) != FileBlocked)
566     {
567 	FileChainFree (file->input);
568 	file->input = NULL;
569 	FileChainFree (file->output);
570 	file->output = NULL;
571 	return 1;
572     }
573     return 0;
574 }
575 
576 static Bool
FilePrint(Value f,Value av,char format,int base,int width,int prec,int fill)577 FilePrint (Value f, Value av, char format, int base, int width, int prec, int fill)
578 {
579     FilePuts (f, "file");
580     return True;
581 }
582 
583 ValueRep FileRep = {
584     { FileMark, FileFree, "FileRep" },
585     rep_file,
586     {
587 	0, 0, 0, 0, 0, 0,
588 	0, ValueEqual, 0, 0,
589     },
590     {
591 	0,
592     },
593     0,
594     0,
595     FilePrint,
596 };
597 
598 Value
NewFile(int fd)599 NewFile (int fd)
600 {
601     ENTER ();
602     Value   ret;
603 
604     ret = ALLOCATE (&FileRep.data, sizeof (File));
605     ret->file.next = 0;
606     ret->file.fd = fd;
607     ret->file.pid = 0;
608     ret->file.status = 0;
609     ret->file.flags = 0;
610     ret->file.error = 0;
611     ret->file.input = 0;
612     ret->file.output = 0;
613     RETURN (ret);
614 }
615 
616 
617 void
FileSetFd(int fd)618 FileSetFd (int fd)
619 {
620     int	flags;
621 
622     fcntl (fd, F_SETOWN, getpid());
623     flags = fcntl (fd, F_GETFL);
624     flags |= ASYNC;
625     (void) fcntl (fd, F_SETFL, flags);
626 #ifdef USE_STREAMS_ASYNC
627     (void) ioctl(fd, I_SETSIG, S_INPUT | S_OUTPUT | S_ERROR | S_HANGUP);
628 #endif
629 }
630 
631 void
FileResetFd(int fd)632 FileResetFd (int fd)
633 {
634     int	flags;
635 
636     flags = fcntl (fd, F_GETFL);
637     flags &= ~ASYNC;
638     (void) fcntl (fd, F_SETFL, flags);
639 #ifdef  USE_STREAMS_ASYNC
640     (void) ioctl(fd, I_SETSIG, 0);
641 #endif
642 }
643 
644 Value
FileCreate(int fd,int flags)645 FileCreate (int fd, int flags)
646 {
647     ENTER ();
648     Value   file;
649 
650     file = NewFile (fd);
651     file->file.flags |= flags;
652     if (isatty (fd))
653 	file->file.flags |= FileLineBuf;
654     else if (lseek (fd, 0, 1) < 0)
655 	file->file.flags |= FileIsPipe;
656     if (fd >= 3)
657 	FileSetFd (fd);
658     file->file.sock_family = 0;
659     RETURN (file);
660 }
661 
662 Value
FileFopen(char * name,char * mode,int * errp)663 FileFopen (char *name, char *mode, int *errp)
664 {
665     ENTER ();
666     int	    oflags = 0;
667     int	    flags = 0;
668     int	    fd;
669 
670     switch (mode[0]) {
671     case 'r':
672 	if (mode[1] == '+')
673 	{
674 	    flags |= FileWritable;
675 	    oflags = 2;
676 	}
677 	else
678 	    oflags = 0;
679 	flags |= FileReadable;
680 	break;
681     case 'w':
682 	if (mode[1] == '+')
683 	{
684 	    oflags = 2;
685 	    flags |= FileReadable;
686 	}
687 	else
688 	    oflags = 1;
689 	oflags |= O_TRUNC|O_CREAT;
690 	flags |= FileWritable;
691 	break;
692     case 'a':
693 	if (mode[1] == '+')
694 	{
695 	    oflags = 2;
696 	    flags |= FileReadable;
697 	}
698 	else
699 	    oflags = 1;
700 	oflags |= O_CREAT|O_APPEND;
701 	flags |= FileWritable;
702 	break;
703     }
704     fd = open (name, oflags, 0666);
705     if (fd < 0)
706     {
707 	*errp = errno;
708 	RETURN (0);
709     }
710     RETURN (FileCreate (fd, flags));
711 }
712 
713 Value
FileReopen(char * name,char * mode,Value file,int * errp)714 FileReopen (char *name, char *mode, Value file, int *errp)
715 {
716     ENTER ();
717     int	    oflags = 0;
718     int	    flags = 0;
719     int	    fd;
720 
721     if (file->file.flags & FileString)
722     {
723 	RaiseStandardException (exception_invalid_argument, 3,
724 				NewStrString ("Reopen: string file"),
725 				NewInt (0), file);
726 	RETURN (Void);
727     }
728 
729     switch (mode[0]) {
730     case 'r':
731 	if (mode[1] == '+')
732 	{
733 	    flags |= FileWritable;
734 	    oflags = 2;
735 	}
736 	else
737 	    oflags = 0;
738 	flags |= FileReadable;
739 	break;
740     case 'w':
741 	if (mode[1] == '+')
742 	{
743 	    oflags = 2;
744 	    flags |= FileReadable;
745 	}
746 	else
747 	    oflags = 1;
748 	oflags |= O_TRUNC|O_CREAT;
749 	flags |= FileWritable;
750 	break;
751     case 'a':
752 	if (mode[1] == '+')
753 	{
754 	    oflags = 2;
755 	    flags |= FileReadable;
756 	}
757 	else
758 	    oflags = 1;
759 	oflags |= O_TRUNC|O_CREAT|O_APPEND;
760 	flags |= FileWritable;
761 	break;
762     }
763     fd = open (name, oflags, 0666);
764     if (fd < 0)
765     {
766 	*errp = errno;
767 	RETURN (0);
768     }
769     if (dup2 (fd, file->file.fd) < 0)
770     {
771 	*errp = errno;
772 	close (fd);
773 	RETURN (0);
774     }
775     close (fd);
776     RETURN (file);
777 }
778 
779 Value
FileFilter(char * program,char * args[],Value filev,int * errp)780 FileFilter (char *program, char *args[], Value filev, int *errp)
781 {
782     ENTER ();
783     int	    pid;
784     int     errcode, nread;
785     int	    i;
786     int     errpipe[2];
787     int     fdlimit;
788     int     fds[3];
789 
790     /* set up process files */
791     for (i = 0; i < 3; i++) {
792 	Value f = ArrayValue (&filev->array, i);
793 	if (i == 0 && !(f->file.flags & FileReadable)) {
794 	    RaiseStandardException (exception_invalid_argument, 3,
795 				    NewStrString ("File::filter: process input not readable"),
796 				    NewInt (i), f);
797 	    RETURN (Void);
798 	}
799 	if (i == 1 && !(f->file.flags & FileWritable)) {
800 	    RaiseStandardException (exception_invalid_argument, 3,
801 				    NewStrString ("File::filter: process output not writable"),
802 				    NewInt (i), f);
803 	    RETURN (Void);
804 	}
805 	if (i == 2 && !(f->file.flags & FileWritable)) {
806 	    RaiseStandardException (exception_invalid_argument, 3,
807 				    NewStrString ("File::filter: process error not writable"),
808 				    NewInt (i), f);
809 	    RETURN (Void);
810 	}
811 	fds[i] = f->file.fd;
812     }
813 
814     if (pipe (errpipe) < 0) {
815 	*errp = errno;
816 	RETURN (0);
817     }
818     pid = fork ();
819     if (pid == -1) {
820 	close (errpipe[0]);
821 	close (errpipe[1]);
822 	*errp = errno;
823 	RETURN (0);
824     }
825     if (pid == 0) {
826 	/* child */
827 	for (i = 0; i < 3; i++)
828 	    dup2 (fds[i], i);
829 	fdlimit = sysconf(_SC_OPEN_MAX);
830 	for (; i < fdlimit; i++)
831 	    if (i != errpipe[1])
832 		close (i);
833 	fcntl (errpipe[1], F_SETFD, FD_CLOEXEC);
834 	execvp (program, args);
835 	errcode = errno & 0xff;
836 	errcode = write (errpipe[1], &errcode, 1);
837 	(void) errcode;
838 	exit (1);
839     }
840     /* parent */
841     close (errpipe[1]);
842     nread = read(errpipe[0], &errcode, 1);
843     close (errpipe[0]);
844     if (nread != 0) {
845 	*errp = errcode;
846 	assert (nread == 1);
847 	RETURN(0);
848     }
849     for (i = 0; i < 3; i++) {
850 	Value f = ArrayValue (&filev->array, i);
851 	if (f->file.flags & FilePipe)
852 	    f->file.pid = pid;
853     }
854     RETURN (NewInt(pid));
855 }
856 
857 Value
FileMakePipe(int * errp)858 FileMakePipe (int *errp)
859 {
860     ENTER ();
861     Value   file, files;
862     int	    two = 2;
863     int     fds[2];
864 
865     if (pipe (fds) < 0) {
866 	*errp = errno;
867 	RETURN (0);
868     }
869 
870     /* gather and return results */
871     files = NewArray (False, False, typePrim[rep_file], 1, &two);
872     file = FileCreate (fds[0], FileReadable);
873     file->file.flags |= FilePipe;
874     ArrayValueSet (&files->array, 0, file);
875     file = FileCreate (fds[1], FileWritable);
876     file->file.flags |= FilePipe;
877     ArrayValueSet (&files->array, 1, file);
878     RETURN (files);
879 }
880 
881 int
FileStatus(Value file)882 FileStatus (Value file)
883 {
884     return file->file.status;
885 }
886 
887 int
FileClose(Value file)888 FileClose (Value file)
889 {
890     file->file.flags |= FileClosed;
891     return FileFlush (file, False);
892 }
893 
894 Value
FileStringRead(char * string,int len)895 FileStringRead (char *string, int len)
896 {
897     ENTER ();
898     Value   file;
899 
900     file = NewFile (-1);
901     file->file.flags |= FileString|FileReadable;
902     file->file.input = FileChainAlloc (0, len);
903     memcpy (FileBuffer (file->file.input), string, len);
904     file->file.input->used = len;
905     RETURN (file);
906 }
907 
908 Value
FileStringWrite(void)909 FileStringWrite (void)
910 {
911     ENTER ();
912     Value   file;
913 
914     file = NewFile (-1);
915     file->file.flags |= FileString|FileWritable;
916     RETURN (file);
917 }
918 
919 static char *
write_chain(char * s,FileChainPtr out)920 write_chain(char *s, FileChainPtr out)
921 {
922     if (!out)
923 	return s;
924     s = write_chain(s, out->next);
925     memcpy(s, FileBuffer(out), out->used);
926     return s + out->used;
927 }
928 
929 Value
FileStringString(Value file)930 FileStringString (Value file)
931 {
932     ENTER ();
933     int		    len;
934     FileChainPtr    out;
935     Value	    str;
936     char	    *s;
937 
938     if (!(file->file.flags & FileString))
939     {
940 	RaiseStandardException (exception_invalid_argument, 3,
941 				NewStrString ("string_string: not string file"),
942 				NewInt (0), file);
943 	RETURN (Void);
944     }
945     len = 0;
946     for (out = file->file.output; out; out = out->next)
947 	len += out->used;
948     str = NewString (len);
949     StringChars (&str->string);
950     s = write_chain(StringChars(&str->string), file->file.output);
951     *s = '\0';
952     RETURN (str);
953 }
954 
955 #define DontBlockIO	(runnable && running)
956 
957 Bool
FileIsReadable(int fd)958 FileIsReadable (int fd)
959 {
960     fd_set	    bits;
961     int		    n;
962     struct timeval  tv;
963 
964     if (fd == 0 && !stdinOwned)
965     {
966 	if (!stdinPolling)
967 	    IoNoticeTtyUnowned ();
968 	return False;
969     }
970     do
971     {
972 	FD_ZERO (&bits);
973 	FD_SET (fd, &bits);
974 	tv.tv_usec = 0;
975 	tv.tv_sec = 0;
976 	n = select (fd + 1, &bits, 0, 0, &tv);
977     } while (n < 0 && errno == EINTR);
978     return n > 0;
979 }
980 
981 Bool
FileIsWritable(int fd)982 FileIsWritable (int fd)
983 {
984     fd_set	    bits;
985     int		    n;
986     struct timeval  tv;
987 
988     do
989     {
990 	FD_ZERO (&bits);
991 	FD_SET (fd, &bits);
992 	tv.tv_usec = 0;
993 	tv.tv_sec = 0;
994 	n = select (fd + 1, 0, &bits, 0, &tv);
995     } while (n < 0 && errno == EINTR);
996     return n > 0;
997 }
998 
999 int
FileInput(Value file)1000 FileInput (Value file)
1001 {
1002     ENTER ();
1003     int		    c, n;
1004     unsigned char   *buf;
1005     FileChainPtr    ic;
1006     int		    err;
1007 
1008     if (file->file.flags & FileClosed)
1009     {
1010 	EXIT ();
1011 	return FileError;
1012     }
1013     if (!file->file.input)
1014     {
1015 	if (!(file->file.flags & FileReadable))
1016 	{
1017 	    file->file.flags |= FileInputError;
1018 	    file->file.input_errno = EBADF;
1019 	    EXIT ();
1020 	    return FileError;
1021 	}
1022 	if (file->file.flags & FileString)
1023 	{
1024 	    file->file.flags |= FileEnd;
1025 	    EXIT ();
1026 	    return FileEOF;
1027 	}
1028 	file->file.input = FileChainAlloc (NULL, FileBufferSize);
1029     }
1030     ic = file->file.input;
1031     for (;;)
1032     {
1033 	if (ic->ptr < ic->used)
1034 	{
1035 	    c = FileBuffer (ic)[ic->ptr++];
1036 	    break;
1037 	}
1038 	else
1039 	{
1040 	    if (ic->next)
1041 	    {
1042 		file->file.input = ic->next;
1043 		ic->next = NULL;
1044 		FileChainFree (ic);
1045 		ic = file->file.input;
1046 	    }
1047 	    else if (file->file.flags & FileString)
1048 	    {
1049 		file->file.flags |= FileEnd;
1050 		c = FileEOF;
1051 		break;
1052 	    }
1053 	    else
1054 	    {
1055 		buf = FileBuffer (ic);
1056 		if (FileIsReadable (file->file.fd))
1057 		{
1058 		    n = ic->size;
1059 		    if (file->file.flags & FileUnBuf)
1060 			n = 1;
1061 		    n = read (file->file.fd, buf, n);
1062 		    err = errno;
1063 		    file->file.flags &= ~FileEnd;
1064 		}
1065 		else
1066 		{
1067 		    n = -1;
1068 		    err = EWOULDBLOCK;
1069 		}
1070 		if (n <= 0)
1071 		{
1072 		    if (n == 0)
1073 		    {
1074 			file->file.flags |= FileEnd;
1075 			c = FileEOF;
1076 		    }
1077 		    else if (err == EWOULDBLOCK)
1078 		    {
1079 			FileSetBlocked (file, FileInputBlocked);
1080 			c = FileBlocked;
1081 		    }
1082 		    else
1083 		    {
1084 			file->file.flags |= FileInputError;
1085 			file->file.input_errno = err;
1086 			c = FileError;
1087 		    }
1088 		    break;
1089 		}
1090 		ic->ptr = 0;
1091 		ic->used = n;
1092 	    }
1093 	}
1094     }
1095     EXIT ();
1096     return c;
1097 }
1098 
1099 void
FileUnput(Value file,unsigned char c)1100 FileUnput (Value file, unsigned char c)
1101 {
1102     ENTER ();
1103     FileChainPtr	ic;
1104 
1105     ic = file->file.input;
1106     if (!ic || ic->ptr == 0)
1107     {
1108 	ic = file->file.input = FileChainAlloc (file->file.input, FileBufferSize);
1109 	ic->ptr = ic->used = ic->size;
1110     }
1111     FileBuffer(ic)[--ic->ptr] = c;
1112     EXIT ();
1113 }
1114 
1115 static void
FileWaitForWriteable(Value file)1116 FileWaitForWriteable (Value file)
1117 {
1118     int	    n;
1119     fd_set  bits;
1120 
1121     FD_ZERO (&bits);
1122     for (;;)
1123     {
1124 	FD_SET (file->file.fd, &bits);
1125 	n = select (file->file.fd + 1, 0, &bits, 0, 0);
1126 	if (n > 0)
1127 	    break;
1128     }
1129 }
1130 
1131 static int
FileFlushChain(Value file,FileChainPtr ic,Bool block)1132 FileFlushChain (Value file, FileChainPtr ic, Bool block)
1133 {
1134     int	    n;
1135     int	    err;
1136 
1137     while (ic->ptr < ic->used)
1138     {
1139 	if (FileIsWritable (file->file.fd))
1140 	{
1141 	    n = write (file->file.fd, &FileBuffer(ic)[ic->ptr], ic->used - ic->ptr);
1142 	    err = errno;
1143 	}
1144 	else
1145 	{
1146 	    n = -1;
1147 	    err = EWOULDBLOCK;
1148 	}
1149 	if (n > 0)
1150 	    ic->ptr += n;
1151 	else
1152 	{
1153 	    if (n < 0 && err != EWOULDBLOCK)
1154 	    {
1155 		file->file.flags |= FileOutputError;
1156 		file->file.output_errno = err;
1157 		return FileError;
1158 	    }
1159 	    if (!(file->file.flags & FileBlockWrites) && !block)
1160 	    {
1161 		FileSetBlocked (file, FileOutputBlocked);
1162 		return FileBlocked;
1163 	    }
1164 	    FileWaitForWriteable (file);
1165 	}
1166     }
1167     return 0;
1168 }
1169 
1170 /*
1171  * May not allocate memory as it is called while garbage collecting
1172  */
1173 
1174 int
FileFlush(Value file,Bool block)1175 FileFlush (Value file, Bool block)
1176 {
1177     ENTER ();
1178     FileChainPtr    ic, *prev;
1179     int		    n = 0;
1180 
1181     if (file->file.output)
1182     {
1183 	if ((file->file.flags & FileString) == 0)
1184 	{
1185 	    for (;;)
1186 	    {
1187 		for (prev = &file->file.output; (ic = *prev)->next; prev = &ic->next);
1188 		n = FileFlushChain (file, ic, block);
1189 		if (n)
1190 		    break;
1191 		/*
1192 		 * Leave a chain for new output
1193 		 */
1194 		if (prev == &file->file.output)
1195 		{
1196 		    ic->used = ic->ptr = 0;
1197 		    break;
1198 		}
1199 		else
1200 		    FileChainFree (ic);
1201 		*prev = 0;
1202 	    }
1203 	}
1204     }
1205     if (file->file.flags & FileClosed && n != FileBlocked)
1206     {
1207 	if (file->file.fd != -1)
1208 	{
1209 	    FileResetFd (file->file.fd);
1210 	    close (file->file.fd);
1211 	    file->file.fd = -1;
1212 	}
1213     }
1214     EXIT ();
1215     return n;
1216 }
1217 
1218 int
FileOutput(Value file,char c)1219 FileOutput (Value file, char c)
1220 {
1221     ENTER ();
1222     FileChainPtr	ic;
1223 
1224     if (file->file.flags & FileClosed)
1225     {
1226 	file->file.flags |= FileOutputError;
1227 	file->file.output_errno = EBADF;
1228 	EXIT ();
1229 	return FileError;
1230     }
1231     if (!(file->file.flags & FileWritable))
1232     {
1233 	file->file.flags |= FileOutputError;
1234 	file->file.output_errno = EBADF;
1235 	EXIT ();
1236 	return FileError;
1237     }
1238     ic = file->file.output;
1239     if (!ic)
1240 	ic = file->file.output = FileChainAlloc (0, FileBufferSize);
1241     if (ic->used == ic->size)
1242     {
1243 	if (FileFlush (file, False) == FileError)
1244 	{
1245 	    EXIT ();
1246 	    return FileError;
1247 	}
1248 	ic = file->file.output;
1249 	if (ic->used == ic->size)
1250 	    ic = file->file.output = FileChainAlloc (file->file.output, FileBufferSize);
1251     }
1252     ic = file->file.output;
1253     FileBuffer(ic)[ic->used++] = c;
1254     if ((c == '\n' && file->file.flags & FileLineBuf) ||
1255 	file->file.flags & FileUnBuf)
1256     {
1257 	if (FileFlush (file, False) == FileError)
1258 	{
1259 	    EXIT ();
1260 	    return FileError;
1261 	}
1262     }
1263     EXIT ();
1264     return 0;
1265 }
1266 
1267 void
FilePuts(Value file,char * s)1268 FilePuts (Value file, char *s)
1269 {
1270     while (*s)
1271 	FileOutput (file, *s++);
1272 }
1273 
1274 void
FilePutsc(Value file,char * s,long length)1275 FilePutsc (Value file, char *s, long length)
1276 {
1277     while (length--)
1278 	FileOutput (file, *s++);
1279 }
1280 
1281 void
FilePutDoubleDigitBase(Value file,double_digit a,int base)1282 FilePutDoubleDigitBase (Value file, double_digit a, int base)
1283 {
1284     int	    digit;
1285     char    space[64], *s;
1286 
1287     s = space + sizeof (space);
1288     *--s = '\0';
1289     if (!a)
1290 	*--s = '0';
1291     else
1292     {
1293 	while (a)
1294 	{
1295 	    digit = a % base;
1296 	    if (digit <= 9)
1297 		digit = '0' + digit;
1298 	    else
1299 		digit = 'a' + digit - 10;
1300 	    *--s = digit;
1301 	    a /= base;
1302 	}
1303     }
1304     FilePuts (file, s);
1305 }
1306 
1307 void
FilePutUIntBase(Value file,unsigned int a,int base)1308 FilePutUIntBase (Value file, unsigned int a, int base)
1309 {
1310     FilePutDoubleDigitBase (file, (double_digit) a, base);
1311 }
1312 
1313 void
FilePutIntBase(Value file,int a,int base)1314 FilePutIntBase (Value file, int a, int base)
1315 {
1316     if (a < 0)
1317     {
1318 	FileOutput (file, '-');
1319 	a = -a;
1320     }
1321     FilePutUIntBase (file, a, base);
1322 }
1323 
FilePutInt(Value file,int a)1324 void	FilePutInt (Value file, int a)
1325 {
1326     FilePutIntBase (file, a, 10);
1327 }
1328 
1329 int
FileStringWidth(char * string,long length,char format)1330 FileStringWidth (char *string, long length, char format)
1331 {
1332     if (format == 's')
1333 	return StringLength (string, length);
1334     else
1335     {
1336 	int	    width = 2;
1337 	unsigned    c;
1338 	while ((string = StringNextChar (string, &c, &length)))
1339 	{
1340 	    if (c < ' ' || '~' < c)
1341 		switch (c) {
1342 		case '\n':
1343 		case '\r':
1344 		case '\t':
1345 		case '\b':
1346 		case '\f':
1347 		case '\v':
1348 		case '\0':
1349 		    width += 2;
1350 		    break;
1351 		default:
1352 		    width += 4;
1353 		    break;
1354 		}
1355 	    else if (c == '"')
1356 		width += 2;
1357 	    else
1358 		width++;
1359 	}
1360 	return width;
1361     }
1362 }
1363 
1364 void
FilePutString(Value f,char * string,long length,char format)1365 FilePutString (Value f, char *string, long length, char format)
1366 {
1367     if (format == 's')
1368 	FilePutsc (f, string, length);
1369     else
1370     {
1371 	unsigned c;
1372 	FileOutput (f, '"');
1373 	while ((string = StringNextChar (string, &c, &length)))
1374 	{
1375 	    if (c < ' ')
1376 		switch (c) {
1377 		case '\n':
1378 		    FilePuts (f, "\\n");
1379 		    break;
1380 		case '\r':
1381 		    FilePuts (f, "\\r");
1382 		    break;
1383 		case '\b':
1384 		    FilePuts (f, "\\b");
1385 		    break;
1386 		case '\t':
1387 		    FilePuts (f, "\\t");
1388 		    break;
1389 		case '\f':
1390 		    FilePuts (f, "\\f");
1391 		    break;
1392 		case '\v':
1393 		    FilePuts (f, "\\v");
1394 		case '\0':
1395 		    FilePuts (f, "\\0");
1396 		    break;
1397 		default:
1398 		    FileOutput (f, '\\');
1399 		    Print (f, NewInt (c), 'o', 8, 3, -1, '0');
1400 		    break;
1401 		}
1402 	    else if (c == '"')
1403 		FilePuts (f, "\\\"");
1404 	    else if (c == '\\')
1405 		FilePuts (f, "\\\\");
1406 	    else
1407 	    {
1408 		char	dest[7];
1409 		int l = StringPutChar (c, dest);
1410 		dest[l] = '\0';
1411 		FilePuts (f, dest);
1412 	    }
1413 	}
1414 	FileOutput (f, '"');
1415     }
1416 }
1417 
1418 void
FilePutRep(Value f,Rep tag,Bool minimal)1419 FilePutRep (Value f, Rep tag, Bool minimal)
1420 {
1421     switch (tag) {
1422     case rep_undef:
1423 	if (!minimal)
1424 	    FilePuts (f, "poly");
1425 	break;
1426     case rep_int:
1427     case rep_integer:
1428 	FilePuts (f, "int");
1429 	break;
1430     case rep_rational:
1431 	FilePuts (f, "rational");
1432 	break;
1433     case rep_float:
1434 	FilePuts (f, "real");
1435 	break;
1436     case rep_string:
1437 	FilePuts (f, "string");
1438 	break;
1439     case rep_file:
1440 	FilePuts (f, "file");
1441 	break;
1442     case rep_thread:
1443 	FilePuts (f, "thread");
1444 	break;
1445     case rep_semaphore:
1446 	FilePuts (f, "semaphore");
1447 	break;
1448     case rep_continuation:
1449 	FilePuts (f, "continuation");
1450 	break;
1451     case rep_bool:
1452 	FilePuts (f, "bool");
1453 	break;
1454     case rep_foreign:
1455 	FilePuts (f, "foreign");
1456 	break;
1457     case rep_void:
1458 	FilePuts (f, "void");
1459 	break;
1460 
1461     case rep_array:
1462 	FilePuts (f, "array");
1463 	break;
1464     case rep_ref:
1465 	FilePuts (f, "ref");
1466 	break;
1467     case rep_struct:
1468 	FilePuts (f, "struct");
1469 	break;
1470     case rep_func:
1471 	FilePuts (f, "function");
1472 	break;
1473     default:
1474 	FilePrintf (f, "bad type %d", tag);
1475 	break;
1476     }
1477     if (minimal && tag != rep_undef)
1478 	FilePuts (f, " ");
1479 }
1480 
1481 void
FilePutClass(Value f,Class storage,Bool minimal)1482 FilePutClass (Value f, Class storage, Bool minimal)
1483 {
1484     switch (storage) {
1485     case class_undef:
1486 	if (!minimal)
1487 	    FilePuts (f, "undefined");
1488 	break;
1489     case class_const:
1490 	FilePuts (f, "const");
1491 	break;
1492     case class_global:
1493 	FilePuts (f, "global");
1494 	break;
1495     case class_arg:
1496 	FilePuts (f, "argument");
1497 	break;
1498     case class_auto:
1499 	FilePuts (f, "auto");
1500 	break;
1501     case class_static:
1502 	FilePuts (f, "static");
1503 	break;
1504     case class_typedef:
1505 	FilePuts (f, "typedef");
1506 	break;
1507     case class_namespace:
1508 	FilePuts (f, "namespace");
1509 	break;
1510     case class_exception:
1511 	FilePuts (f, "exception");
1512 	break;
1513     }
1514     if (minimal && storage != class_undef)
1515 	FilePuts (f, " ");
1516 }
1517 
1518 void
FilePutPublish(Value f,Publish publish,Bool minimal)1519 FilePutPublish (Value f, Publish publish, Bool minimal)
1520 {
1521     switch (publish) {
1522     case publish_private:
1523 	if (!minimal)
1524 	    FilePuts (f, "private");
1525 	break;
1526     case publish_protected:
1527 	FilePuts (f, "protected");
1528 	break;
1529     case publish_public:
1530 	FilePuts (f, "public");
1531 	break;
1532     case publish_extend:
1533 	FilePuts (f, "extend");
1534 	break;
1535     }
1536     if (minimal && publish != publish_private)
1537 	FilePuts (f, " ");
1538 }
1539 
1540 void
FilePutArgType(Value f,ArgType * at)1541 FilePutArgType (Value f, ArgType *at)
1542 {
1543     FilePuts (f, "(");
1544     while (at)
1545     {
1546 	if (at->type)
1547 	    FilePutType (f, at->type, at->name != 0);
1548 	if (at->name)
1549 	    FilePuts (f, AtomName (at->name));
1550 	if (at->varargs)
1551 	    FilePuts (f, " ...");
1552 	at = at->next;
1553 	if (at)
1554 	    FilePuts (f, ", ");
1555     }
1556     FilePuts (f, ")");
1557 }
1558 
1559 static void
FilePutDimensions(Value f,ExprPtr dims,Bool resizable)1560 FilePutDimensions (Value f, ExprPtr dims, Bool resizable)
1561 {
1562     while (dims)
1563     {
1564 	if (dims->tree.left)
1565 	    PrettyExpr (f, dims->tree.left, -1, 0, False);
1566 	else if (resizable)
1567 	    FilePuts (f, "...");
1568 	else
1569 	    FilePuts (f, "*");
1570 	if (dims->tree.right)
1571 	    FilePuts (f, ", ");
1572 	dims = dims->tree.right;
1573     }
1574 }
1575 
1576 static void
FilePutTypename(Value f,ExprPtr e)1577 FilePutTypename (Value f, ExprPtr e)
1578 {
1579     switch (e->base.tag) {
1580     case COLONCOLON:
1581 	if (e->tree.left)
1582 	{
1583 	    FilePutTypename (f, e->tree.left);
1584 	    FilePuts (f, "::");
1585 	}
1586 	FilePutTypename (f, e->tree.right);
1587 	break;
1588     case NAME:
1589 	FilePuts (f, AtomName (e->atom.atom));
1590 	break;
1591     }
1592 }
1593 
1594 void
FilePutBaseType(Value f,Type * t,Bool minimal)1595 FilePutBaseType (Value f, Type *t, Bool minimal)
1596 {
1597     switch (t->base.tag) {
1598     case type_func:
1599 	FilePutBaseType (f, t->func.ret, minimal);
1600 	break;
1601     case type_array:
1602 	FilePutBaseType (f, t->array.type, minimal);
1603 	break;
1604     case type_hash:
1605 	FilePutBaseType (f, t->hash.type, minimal);
1606 	break;
1607     default:
1608 	FilePutType (f, t, minimal);
1609 	break;
1610     }
1611 }
1612 
1613 void
FilePutSubscriptType(Value f,Type * t,Bool minimal)1614 FilePutSubscriptType (Value f, Type *t, Bool minimal)
1615 {
1616     switch (t->base.tag) {
1617     case type_func:
1618 	FilePutArgType (f, t->func.args);
1619 	FilePutSubscriptType (f, t->func.ret, minimal);
1620 	break;
1621     case type_array:
1622 	FilePuts (f, "[");
1623 	FilePutDimensions (f, t->array.dimensions, t->array.resizable);
1624 	FilePuts (f, "]");
1625 	FilePutSubscriptType (f, t->array.type, minimal);
1626 	break;
1627     case type_hash:
1628 	FilePuts (f, "[");
1629 	FilePutType (f, t->hash.keyType, False);
1630 	FilePuts (f, "]");
1631 	FilePutSubscriptType (f, t->hash.type, minimal);
1632 	break;
1633     default:
1634 	break;
1635     }
1636 }
1637 
1638 void
FilePutType(Value f,Type * t,Bool minimal)1639 FilePutType (Value f, Type *t, Bool minimal)
1640 {
1641     int		    i;
1642     StructType	    *st;
1643     Bool	    spaceit = minimal;
1644     TypeElt	    *elt;
1645 
1646     if (!t)
1647     {
1648 	FilePuts (f, "<undefined>");
1649 	return;
1650     }
1651     switch (t->base.tag) {
1652     case type_prim:
1653 	if (t->prim.prim != rep_undef || !minimal)
1654 	    FilePutRep (f, t->prim.prim, False);
1655 	else
1656 	    spaceit = False;
1657 	break;
1658     case type_name:
1659 	FilePutTypename (f, t->name.expr);
1660 	break;
1661     case type_ref:
1662 	if (t->ref.pointer)
1663 	    FilePuts (f, "*");
1664 	else
1665 	    FilePuts (f, "&");
1666 	FilePutType (f, t->ref.ref, False);
1667 	break;
1668     case type_func:
1669     case type_array:
1670     case type_hash:
1671 	FilePutBaseType (f, t, False);
1672 	FilePutSubscriptType (f, t, False);
1673 	break;
1674     case type_struct:
1675     case type_union:
1676 	if (t->structs.left && t->structs.right)
1677 	{
1678 	    FilePutType (f, t->structs.left, False);
1679 	    FilePuts (f, " + ");
1680 	    FilePutType (f, t->structs.right, False);
1681 	}
1682 	else if (t->structs.enumeration)
1683 	{
1684 	    FilePuts (f, "enum { ");
1685 	    st = t->structs.structs;
1686 	    for (i = 0; i < st->nelements; i++)
1687 	    {
1688 		if (i)
1689 		    FilePuts (f, ", ");
1690 		FilePuts (f, AtomName (StructTypeAtoms(st)[i]));
1691 	    }
1692 	    FilePuts (f, " }");
1693 	}
1694 	else
1695 	{
1696 	    if (t->base.tag == type_struct)
1697 		FilePuts (f, "struct { ");
1698 	    else
1699 		FilePuts (f, "union { ");
1700 	    st = t->structs.structs;
1701 	    for (i = 0; i < st->nelements; i++)
1702 	    {
1703 		FilePutType (f, BoxTypesElements(st->types)[i], True);
1704 		FilePuts (f, AtomName (StructTypeAtoms (st)[i]));
1705 		FilePuts (f, "; ");
1706 	    }
1707 	    FilePuts (f, "}");
1708 	}
1709 	break;
1710     case type_types:
1711 	for (elt = t->types.elt; elt; elt = elt->next)
1712 	{
1713 	    FilePutType (f, elt->type, False);
1714 	    if (elt->next)
1715 		FilePuts (f, ", ");
1716 	}
1717 	break;
1718     }
1719     if (spaceit)
1720 	FilePuts (f, " ");
1721 }
1722 
1723 static void
FilePutBinOp(Value f,BinaryOp o)1724 FilePutBinOp (Value f, BinaryOp o)
1725 {
1726     switch (o) {
1727     case PlusOp:
1728 	FilePuts (f, "+");
1729 	break;
1730     case MinusOp:
1731 	FilePuts (f, "-");
1732 	break;
1733     case TimesOp:
1734 	FilePuts (f, "*");
1735 	break;
1736     case DivideOp:
1737 	FilePuts (f, "/");
1738 	break;
1739     case DivOp:
1740 	FilePuts (f, "//");
1741 	break;
1742     case ModOp:
1743 	FilePuts (f, "%");
1744 	break;
1745     case LessOp:
1746 	FilePuts (f, "<");
1747 	break;
1748     case EqualOp:
1749 	FilePuts (f, "==");
1750 	break;
1751     case LandOp:
1752 	FilePuts (f, "&");
1753 	break;
1754     case LorOp:
1755 	FilePuts (f, "|");
1756 	break;
1757     default:
1758 	break;
1759     }
1760 }
1761 
1762 static void
FilePutUnaryOp(Value f,UnaryOp o)1763 FilePutUnaryOp (Value f, UnaryOp o)
1764 {
1765     switch (o) {
1766     case NegateOp:
1767 	FilePuts (f, "-");
1768 	break;
1769     case FloorOp:
1770 	FilePuts (f, "floor");
1771 	break;
1772     case CeilOp:
1773 	FilePuts (f, "ceil");
1774 	break;
1775     default:
1776 	break;
1777     }
1778 }
1779 
1780 void
FileVPrintf(Value file,char * fmt,va_list args)1781 FileVPrintf (Value file, char *fmt, va_list args)
1782 {
1783     Value	v;
1784 
1785     for (;*fmt;) {
1786 	switch (*fmt) {
1787 	case '\0':
1788 	    continue;
1789 	case '%':
1790 	    switch (*++fmt) {
1791 	    case '\0':
1792 		continue;
1793 	    case 'd':
1794 		FilePutIntBase (file, va_arg (args, int), 10);
1795 		break;
1796 	    case 'u':
1797 		FilePutUIntBase (file, va_arg (args, unsigned int), 10);
1798 		break;
1799 	    case 'o':
1800 		FilePutUIntBase (file, va_arg (args, unsigned int), 8);
1801 		break;
1802 	    case 'x':
1803 		FilePutUIntBase (file, va_arg (args, unsigned int), 16);
1804 		break;
1805 	    case 'D':
1806 		FilePutDoubleDigitBase (file, va_arg (args, double_digit), 10);
1807 		break;
1808 	    case 'v':
1809 	    case 'g':
1810 		v = va_arg (args, Value);
1811 		if (!v)
1812 		    (void) FilePuts (file, "<uninit>");
1813 		else
1814 		    Print (file, v, *fmt, 0, 0, DEFAULT_OUTPUT_PRECISION, ' ');
1815 		break;
1816 	    case 'G':
1817 		v = va_arg (args, Value);
1818 		if (!v)
1819 		    (void) FilePuts (file, "<uninit>");
1820 		else {
1821 		    if (ValueRep(v)->tag <= rep_void) {
1822 			Print (file, v, 'g', 0, 0, DEFAULT_OUTPUT_PRECISION, ' ');
1823 		    } else {
1824 			(void) FilePuts (file, "<composite>");
1825 		    }
1826 		}
1827 		break;
1828 	    case 'n':
1829 		FilePuts (file, NaturalSprint (0, va_arg (args, Natural *), 10, 0));
1830 		break;
1831 	    case 'N':
1832 		FilePuts (file, NaturalSprint (0, va_arg (args, Natural *), 16, 0));
1833 		break;
1834 	    case 's':
1835 		(void) FilePuts (file, va_arg (args, char *));
1836 		break;
1837 	    case 'S': {
1838 		char *s = va_arg (args, char *);
1839 		FilePutString (file, s, strlen(s), 'v');
1840 		break;
1841 	    }
1842 	    case 'A':
1843 		(void) FilePuts (file, AtomName (va_arg (args, Atom)));
1844 		break;
1845 	    case 't':
1846 		FilePutType (file, va_arg (args, Type *), True);
1847 		break;
1848 	    case 'T':
1849 		FilePutType (file, va_arg (args, Type *), False);
1850 		break;
1851 	    case 'k':	/* sic */
1852 		FilePutClass (file, (Class) (va_arg (args, int)), True);
1853 		break;
1854 	    case 'C':
1855 		FilePutClass (file, (Class) (va_arg (args, int)), False);
1856 		break;
1857 	    case 'p':
1858 		FilePutPublish (file, (Publish) (va_arg (args, int)), True);
1859 		break;
1860 	    case 'P':
1861 		FilePutPublish (file, (Publish) (va_arg (args, int)), False);
1862 		break;
1863 	    case 'O':
1864 		FilePutBinOp (file, va_arg (args, BinaryOp));
1865 		break;
1866 	    case 'U':
1867 		FilePutUnaryOp (file, va_arg (args, UnaryOp));
1868 		break;
1869 	    case 'c':
1870 		(void) FileOutchar (file, va_arg (args, int));
1871 		break;
1872 	    default:
1873 		(void) FileOutput (file, *fmt);
1874 		break;
1875 	    }
1876 	    break;
1877 	default:
1878 	    (void) FileOutput (file, *fmt);
1879 	    break;
1880 	}
1881 	++fmt;
1882     }
1883 }
1884 
1885 void
FilePrintf(Value file,char * fmt,...)1886 FilePrintf (Value file, char *fmt, ...)
1887 {
1888     va_list args;
1889 
1890     va_start (args, fmt);
1891     FileVPrintf (file, fmt, args);
1892     va_end (args);
1893 }
1894 
1895 void
FileCheckBlocked(Bool block)1896 FileCheckBlocked (Bool block)
1897 {
1898     ENTER ();
1899     fd_set	    readable, writable;
1900     int		    n, fd;
1901     Value	    blocked, *prev;
1902     Bool	    ready;
1903     Bool	    writeBlocked;
1904 #ifdef NO_PIPE_SIGIO
1905     Bool	    readPipeBlocked;
1906 #endif
1907 
1908     FD_ZERO (&readable);
1909     FD_ZERO (&writable);
1910     n = 0;
1911     for (prev = &fileBlocked; (blocked = *prev); )
1912     {
1913 	fd = blocked->file.fd;
1914 	if (fd < 0)
1915 	{
1916 	    *prev = blocked->file.next;
1917 	    continue;
1918 	}
1919 	prev = &blocked->file.next;
1920 	if (fd == 0 && !stdinOwned)
1921 	    continue;
1922 	if (blocked->file.flags & FileInputBlocked)
1923 	    FD_SET (fd, &readable);
1924 	if (blocked->file.flags & FileOutputBlocked)
1925 	    FD_SET (fd, &writable);
1926 	if (fd >= n)
1927 	    n = fd + 1;
1928     }
1929     if (n > 0)
1930     {
1931 	struct timeval  tv, *tvp;
1932 	if (block)
1933 	    tvp = 0;
1934 	else
1935 	{
1936 	    tv.tv_usec = 0;
1937 	    tv.tv_sec = 0;
1938 	    tvp = &tv;
1939 	}
1940 	n = select (n, &readable, &writable, 0, tvp);
1941     }
1942     else
1943     {
1944 	anyFileWriteBlocked = False;
1945 #ifdef NO_PIPE_SIGIO
1946 	anyPipeReadBlocked = False;
1947 #endif
1948 	if (block) {
1949 	    sigset_t	    set, oset;
1950 	    sigfillset (&set);
1951 	    sigprocmask (SIG_SETMASK, &set, &oset);
1952 	    if (!signaling && !running)
1953 		sigsuspend(&oset);
1954 	    sigprocmask (SIG_SETMASK, &oset, &set);
1955 	}
1956     }
1957     if (n > 0)
1958     {
1959 	writeBlocked = False;
1960 #ifdef NO_PIPE_SIGIO
1961 	readPipeBlocked = False;
1962 #endif
1963 	if (block)
1964 	    signaling = True;
1965 	for (prev = &fileBlocked; (blocked = *prev); )
1966 	{
1967 	    fd = blocked->file.fd;
1968 	    ready = False;
1969 	    if (FD_ISSET (fd, &readable))
1970 	    {
1971 		ready = True;
1972 		blocked->file.flags &= ~FileInputBlocked;
1973 	    }
1974 	    if (FD_ISSET (fd, &writable))
1975 	    {
1976 		if (FileFlush (blocked, False) != FileBlocked)
1977 		{
1978 		    blocked->file.flags &= ~FileOutputBlocked;
1979 		    ready = True;
1980 		}
1981 	    }
1982 	    if (blocked->file.flags & FileOutputBlocked)
1983 		writeBlocked = True;
1984 #ifdef NO_PIPE_SIGIO
1985 	    if (blocked->file.flags & FileInputBlocked &&
1986 		blocked->file.flags & FileIsPipe)
1987 		readPipeBlocked = True;
1988 #endif
1989 	    if (ready)
1990 		ThreadsWakeup (blocked, WakeAll);
1991 	    if ((blocked->file.flags & (FileOutputBlocked|FileInputBlocked)) == 0)
1992 		*prev = blocked->file.next;
1993 	    else
1994 		prev = &blocked->file.next;
1995 	}
1996 	anyFileWriteBlocked = writeBlocked;
1997 #ifdef NO_PIPE_SIGIO
1998 	anyPipeReadBlocked = readPipeBlocked;
1999 #endif
2000     }
2001     EXIT ();
2002 }
2003 
2004 void
FileSetBlocked(Value file,int flag)2005 FileSetBlocked (Value file, int flag)
2006 {
2007     if (flag == FileOutputBlocked && !anyFileWriteBlocked)
2008     {
2009 	anyFileWriteBlocked = True;
2010 	IoNoticeWriteBlocked ();
2011     }
2012 #ifdef NO_PIPE_SIGIO
2013     if (flag == FileInputBlocked &&
2014 	(file->file.flags & FileIsPipe) &&
2015 	!anyPipeReadBlocked)
2016     {
2017 	anyPipeReadBlocked = True;
2018 	IoNoticeReadBlocked ();
2019     }
2020 #endif
2021     if (file->file.flags & (FileOutputBlocked|FileInputBlocked))
2022     {
2023 	file->file.flags |= flag;
2024 	return;
2025     }
2026     file->file.flags |= flag;
2027     file->file.next = fileBlocked;
2028     fileBlocked = file;
2029 }
2030 
2031 void
FileSetBuffer(Value file,int mode)2032 FileSetBuffer (Value file, int mode)
2033 {
2034     file->file.flags &= ~(FileLineBuf|FileUnBuf);
2035     switch (mode) {
2036     case 0:
2037 	break;
2038     case 1:
2039 	file->file.flags |= FileLineBuf;
2040 	break;
2041     case 2:
2042 	file->file.flags |= FileUnBuf;
2043 	break;
2044     }
2045 }
2046 
2047 /*
2048  * Output one character in UTF-8 format
2049  */
2050 
2051 int
FileOutchar(Value file,int c)2052 FileOutchar (Value file, int c)
2053 {
2054     char d;
2055     int	bits;
2056 
2057          if (c <       0x80) { d = c;                         bits= -6; }
2058     else if (c <      0x800) { d= ((c >>  6) & 0x1F) | 0xC0;  bits=  0; }
2059     else if (c <    0x10000) { d= ((c >> 12) & 0x0F) | 0xE0;  bits=  6; }
2060     else if (c <   0x200000) { d= ((c >> 18) & 0x07) | 0xF0;  bits= 12; }
2061     else if (c <  0x4000000) { d= ((c >> 24) & 0x03) | 0xF8;  bits= 18; }
2062     else if (c < 0x80000000) { d= ((c >> 30) & 0x01) | 0xFC;  bits= 24; }
2063     else return FileError;
2064 
2065     if (FileOutput (file, d) < 0)
2066 	return FileError;
2067 
2068     for ( ; bits >= 0; bits-= 6)
2069 	if (FileOutput (file, ((c >> bits) & 0x3F) | 0x80) < 0)
2070 	    return FileError;
2071 
2072     return 0;
2073 }
2074 
2075 int
FileInchar(Value file)2076 FileInchar (Value file)
2077 {
2078     char    buf[6];
2079     int	    n = 0;
2080     int	    result;
2081     int	    mask;
2082     int	    extra;
2083 
2084     result = FileInput (file);
2085     if (result < 0)
2086 	return result;
2087 
2088     buf[n++] = result;
2089     if ((result & 0x80) != 0)
2090     {
2091 	if ((result & 0xc0) != 0xc0)
2092 	{
2093 	    file->file.input_errno = EUTF8;
2094 	    return FileError;
2095 	}
2096 
2097 	mask = 0x20;
2098 	extra = 1;
2099 	while ((result & mask) != 0)
2100 	{
2101 	    extra++;
2102 	    mask >>= 1;
2103 	}
2104 	result &= (mask - 1);
2105 	while (extra-- > 0)
2106 	{
2107 	    int c = FileInput (file);
2108 	    if (c < 0)
2109 	    {
2110 		while (--n >= 0)
2111 		    FileUnput (file, buf[n]);
2112 		return c;
2113 	    }
2114 	    buf[n++] = c;
2115 	    if ((c & 0xc0) != 0x80)
2116 	    {
2117 		file->file.input_errno = EUTF8;
2118 		return FileError;
2119 	    }
2120 	    result = (result << 6) | (c & 0x3f);
2121 	}
2122     }
2123     return result;
2124 }
2125 
2126 void
FileUnchar(Value file,int c)2127 FileUnchar (Value file, int c)
2128 {
2129     char d;
2130     int	bits;
2131 
2132          if (c <       0x80) { d = c;                         bits= -6; }
2133     else if (c <      0x800) { d= ((c >>  6) & 0x1F) | 0xC0;  bits=  0; }
2134     else if (c <    0x10000) { d= ((c >> 12) & 0x0F) | 0xE0;  bits=  6; }
2135     else if (c <   0x200000) { d= ((c >> 18) & 0x07) | 0xF0;  bits= 12; }
2136     else if (c <  0x4000000) { d= ((c >> 24) & 0x03) | 0xF8;  bits= 18; }
2137     else if (c < 0x80000000) { d= ((c >> 30) & 0x01) | 0xFC;  bits= 24; }
2138     else return;
2139 
2140     for ( ; bits >= 0; bits-= 6)
2141     {
2142 	FileUnput (file, (c & 0x3F) | 0x80);
2143 	c >>= 6;
2144     }
2145     FileUnput (file, d);
2146 }
2147