--- /dev/null
+#ifndef lint
+static char *RCSid() { return RCSid("$Id: vms.c,v 1.5 2004/07/01 17:10:09 broeker Exp $"); }
+#endif
+
+/* GNUPLOT - vms.c */
+
+/*[
+ * Copyright 1986 - 1993, 1998, 2004 Thomas Williams, Colin Kelley
+ *
+ * Permission to use, copy, and distribute this software and its
+ * documentation for any purpose with or without fee is hereby granted,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation.
+ *
+ * Permission to modify the software is granted, but not the right to
+ * distribute the complete modified source code. Modifications are to
+ * be distributed as patches to the released version. Permission to
+ * distribute binaries produced by compiling modified sources is granted,
+ * provided you
+ * 1. distribute the corresponding source modifications from the
+ * released version in the form of a patch file along with the binaries,
+ * 2. add special version identification to distinguish your version
+ * in addition to the base release version number,
+ * 3. provide your name and address as the primary contact for the
+ * support of your modified version, and
+ * 4. retain our contact information in regard to use of the base
+ * software.
+ * Permission to distribute the released version of the source code along
+ * with corresponding source modifications in the form of a patch file is
+ * granted with same provisions 2 through 4 for binary distributions.
+ *
+ * This software is provided "as is" without express or implied warranty
+ * to the extent permitted by applicable law.
+]*/
+
+/* drop in popen() / pclose() for VMS
+ * (originally written by drd for port of perl to vms)
+ */
+
+#include "syscfg.h" /* for the prototypes */
+#include "stdfn.h"
+
+static int something_in_this_file;
+
+#ifdef PIPES
+
+/* (to aid porting) - how are errors dealt with */
+
+#define ERROR(msg) { fprintf(stderr, "%s\nFile %s line %d\n", msg, __FILE__, __LINE__); }
+#define FATAL(msg) { fprintf(stderr, "%s\nFile %s line %d\n", msg, __FILE__, __LINE__); exit(EXIT_FAILURE); }
+
+
+#include <dvidef.h>
+#include <syidef.h>
+#include <jpidef.h>
+#include <ssdef.h>
+#include <descrip.h>
+
+#ifdef __DECC /* DECC does not automatically search */
+#include <lib$routines.h>
+#include <starlet.h> /* for the sys$... routines */
+#endif /* __DECC */
+
+#ifndef EXIT_FAILURE /* not in older VAXC <stdlib.h> */
+#define EXIT_FAILURE 0x10000002 /* (STS$K_ERROR | STS$M_INHIB_MSG */
+#endif
+
+#define _cksts(call) \
+ if (!(sts=(call))&1) FATAL("Internal error") else {}
+
+static void
+create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc)
+{
+ static unsigned long int mbxbufsiz;
+ long int syiitm = SYI$_MAXBUF, dviitm = DVI$_DEVNAM;
+ unsigned long sts; /* for _cksts */
+
+ if (!mbxbufsiz) {
+ /*
+ * Get the SYSGEN parameter MAXBUF, and the smaller of it and the
+ * preprocessor consant BUFSIZ from stdio.h as the size of the
+ * 'pipe' mailbox.
+ */
+
+ _cksts(lib$getsyi(&syiitm, &mbxbufsiz, 0, 0, 0, 0));
+ if (mbxbufsiz > BUFSIZ) mbxbufsiz = BUFSIZ;
+ }
+ _cksts(sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0));
+
+ _cksts(lib$getdvi(&dviitm, chan, NULL, NULL, namdsc, &namdsc->dsc$w_length));
+ namdsc->dsc$a_pointer[namdsc->dsc$w_length] = '\0';
+
+} /* end of create_mbx() */
+
+struct pipe_details
+{
+ struct pipe_details *next;
+ FILE *fp;
+ int pid;
+ unsigned long int completion;
+};
+
+static struct pipe_details *open_pipes = NULL;
+static $DESCRIPTOR(nl_desc, "NL:");
+static int waitpid_asleep = 0;
+
+static void
+popen_completion_ast(unsigned long int unused)
+{
+ if (waitpid_asleep) {
+ waitpid_asleep = 0;
+ sys$wake(0,0);
+ }
+}
+
+FILE *
+popen(char *cmd, char *mode)
+{
+ static char mbxname[64];
+ unsigned short int chan;
+ unsigned long int flags=1; /* nowait - gnu c doesn't allow &1 */
+ struct pipe_details *info;
+ struct dsc$descriptor_s namdsc = {sizeof mbxname, DSC$K_DTYPE_T,
+ DSC$K_CLASS_S, mbxname},
+ cmddsc = {0, DSC$K_DTYPE_T,
+ DSC$K_CLASS_S, 0};
+ unsigned long sts;
+
+ if (!(info=malloc(sizeof(struct pipe_details))))
+ {
+ ERROR("Cannot malloc space");
+ return NULL;
+ }
+
+ info->completion=0; /* I assume this will remain 0 until terminates */
+
+ /* create mailbox */
+ create_mbx(&chan,&namdsc);
+
+ /* open a FILE* onto it */
+ info->fp=fopen(mbxname, mode);
+
+ /* give up other channel onto it */
+ _cksts(sys$dassgn(chan));
+
+ if (!info->fp)
+ return NULL;
+
+ cmddsc.dsc$w_length=strlen(cmd);
+ cmddsc.dsc$a_pointer=cmd;
+
+ if (strcmp(mode,"r")==0) {
+ _cksts(lib$spawn(&cmddsc, &nl_desc, &namdsc, &flags,
+ 0 /* name */, &info->pid, &info->completion,
+ 0, popen_completion_ast,0,0,0,0));
+ }
+ else {
+ _cksts(lib$spawn(&cmddsc, &namdsc, 0 /* sys$output */, &flags,
+ 0 /* name */, &info->pid, &info->completion));
+ }
+
+ info->next=open_pipes; /* prepend to list */
+ open_pipes=info;
+
+ return info->fp;
+}
+
+int pclose(FILE *fp)
+{
+ struct pipe_details *info, *last = NULL;
+ unsigned long int abort = SS$_TIMEOUT, retsts;
+ unsigned long sts;
+
+ for (info = open_pipes; info != NULL; last = info, info = info->next)
+ if (info->fp == fp) break;
+
+ if (info == NULL)
+ /* get here => no such pipe open */
+ FATAL("pclose() - no such pipe open ???");
+
+ if (!info->completion) { /* Tap them gently on the shoulder . . .*/
+ _cksts(sys$forcex(&info->pid,0,&abort));
+ sleep(1);
+ }
+ if (!info->completion) /* We tried to be nice . . . */
+ _cksts(sys$delprc(&info->pid));
+
+ fclose(info->fp);
+ /* remove from list of open pipes */
+ if (last) last->next = info->next;
+ else open_pipes = info->next;
+ retsts = info->completion;
+ free(info);
+
+ return retsts;
+} /* end of pclose() */
+
+
+/* sort-of waitpid; use only with popen() */
+/*{{{unsigned long int waitpid(unsigned long int pid, int *statusp, int flags)*/
+unsigned long int
+waitpid(unsigned long int pid, int *statusp, int flags)
+{
+ struct pipe_details *info;
+ unsigned long int abort = SS$_TIMEOUT;
+ unsigned long sts;
+
+ for (info = open_pipes; info != NULL; info = info->next)
+ if (info->pid == pid) break;
+
+ if (info != NULL) { /* we know about this child */
+ while (!info->completion) {
+ waitpid_asleep = 1;
+ sys$hiber();
+ }
+
+ *statusp = info->completion;
+ return pid;
+ }
+ else { /* we haven't heard of this child */
+ $DESCRIPTOR(intdsc,"0 00:00:01");
+ unsigned long int ownercode = JPI$_OWNER, ownerpid, mypid;
+ unsigned long int interval[2];
+
+ _cksts(lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0));
+ _cksts(lib$getjpi(&ownercode,0,0,&mypid,0,0));
+ if (ownerpid != mypid)
+ FATAL("pid not a child");
+
+ _cksts(sys$bintim(&intdsc,interval));
+ while ((sts=lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0)) & 1) {
+ _cksts(sys$schdwk(0,0,interval,0));
+ _cksts(sys$hiber());
+ }
+ _cksts(sts);
+
+ /* There's no easy way to find the termination status a child we're
+ * not aware of beforehand. If we're really interested in the future,
+ * we can go looking for a termination mailbox, or chase after the
+ * accounting record for the process.
+ */
+ *statusp = 0;
+ return pid;
+ }
+
+} /* end of waitpid() */
+
+#endif /* PIPES */
+
+
+/* vax c doesn't come with strftime - watch out for redefn of RCSid */
+#ifdef VAXCRTL
+# define RCSid RCSid2
+# include "strftime.c"
+#endif
projects / gnuplot / blobdiff