#ifndef lint static char *RCSid = "$Id: vms.c,v 1.5 1998/06/18 14:55:22 ddenholm Exp $"; #endif /* GNUPLOT - vms.c */ /*[ * Copyright 1986 - 1993, 1998 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 "plot.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 #include #include #include #include #ifdef __DECC /* DECC does not automatically search */ #include #include /* for the sys$... routines */ #endif /* __DECC */ #ifndef EXIT_FAILURE /* not in older VAXC */ #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