Annotation of OpenXM_contrib/gnuplot/vms.c, Revision 1.1
1.1 ! maekawa 1: #ifndef lint
! 2: static char *RCSid = "$Id: vms.c,v 1.5 1998/06/18 14:55:22 ddenholm Exp $";
! 3: #endif
! 4:
! 5: /* GNUPLOT - vms.c */
! 6:
! 7: /*[
! 8: * Copyright 1986 - 1993, 1998 Thomas Williams, Colin Kelley
! 9: *
! 10: * Permission to use, copy, and distribute this software and its
! 11: * documentation for any purpose with or without fee is hereby granted,
! 12: * provided that the above copyright notice appear in all copies and
! 13: * that both that copyright notice and this permission notice appear
! 14: * in supporting documentation.
! 15: *
! 16: * Permission to modify the software is granted, but not the right to
! 17: * distribute the complete modified source code. Modifications are to
! 18: * be distributed as patches to the released version. Permission to
! 19: * distribute binaries produced by compiling modified sources is granted,
! 20: * provided you
! 21: * 1. distribute the corresponding source modifications from the
! 22: * released version in the form of a patch file along with the binaries,
! 23: * 2. add special version identification to distinguish your version
! 24: * in addition to the base release version number,
! 25: * 3. provide your name and address as the primary contact for the
! 26: * support of your modified version, and
! 27: * 4. retain our contact information in regard to use of the base
! 28: * software.
! 29: * Permission to distribute the released version of the source code along
! 30: * with corresponding source modifications in the form of a patch file is
! 31: * granted with same provisions 2 through 4 for binary distributions.
! 32: *
! 33: * This software is provided "as is" without express or implied warranty
! 34: * to the extent permitted by applicable law.
! 35: ]*/
! 36:
! 37: /* drop in popen() / pclose() for VMS
! 38: * (originally written by drd for port of perl to vms)
! 39: */
! 40:
! 41: #include "plot.h" /* for the prototypes */
! 42: #include "stdfn.h"
! 43:
! 44: static int something_in_this_file;
! 45:
! 46: #ifdef PIPES
! 47:
! 48: /* (to aid porting) - how are errors dealt with */
! 49:
! 50: #define ERROR(msg) { fprintf(stderr, "%s\nFile %s line %d\n", msg, __FILE__, __LINE__); }
! 51: #define FATAL(msg) { fprintf(stderr, "%s\nFile %s line %d\n", msg, __FILE__, __LINE__); exit(EXIT_FAILURE); }
! 52:
! 53:
! 54: #include <dvidef.h>
! 55: #include <syidef.h>
! 56: #include <jpidef.h>
! 57: #include <ssdef.h>
! 58: #include <descrip.h>
! 59:
! 60: #ifdef __DECC /* DECC does not automatically search */
! 61: #include <lib$routines.h>
! 62: #include <starlet.h> /* for the sys$... routines */
! 63: #endif /* __DECC */
! 64:
! 65: #ifndef EXIT_FAILURE /* not in older VAXC <stdlib.h> */
! 66: #define EXIT_FAILURE 0x10000002 /* (STS$K_ERROR | STS$M_INHIB_MSG */
! 67: #endif
! 68:
! 69: #define _cksts(call) \
! 70: if (!(sts=(call))&1) FATAL("Internal error") else {}
! 71:
! 72: static void
! 73: create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc)
! 74: {
! 75: static unsigned long int mbxbufsiz;
! 76: long int syiitm = SYI$_MAXBUF, dviitm = DVI$_DEVNAM;
! 77: unsigned long sts; /* for _cksts */
! 78:
! 79: if (!mbxbufsiz) {
! 80: /*
! 81: * Get the SYSGEN parameter MAXBUF, and the smaller of it and the
! 82: * preprocessor consant BUFSIZ from stdio.h as the size of the
! 83: * 'pipe' mailbox.
! 84: */
! 85:
! 86: _cksts(lib$getsyi(&syiitm, &mbxbufsiz, 0, 0, 0, 0));
! 87: if (mbxbufsiz > BUFSIZ) mbxbufsiz = BUFSIZ;
! 88: }
! 89: _cksts(sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0));
! 90:
! 91: _cksts(lib$getdvi(&dviitm, chan, NULL, NULL, namdsc, &namdsc->dsc$w_length));
! 92: namdsc->dsc$a_pointer[namdsc->dsc$w_length] = '\0';
! 93:
! 94: } /* end of create_mbx() */
! 95:
! 96: struct pipe_details
! 97: {
! 98: struct pipe_details *next;
! 99: FILE *fp;
! 100: int pid;
! 101: unsigned long int completion;
! 102: };
! 103:
! 104: static struct pipe_details *open_pipes = NULL;
! 105: static $DESCRIPTOR(nl_desc, "NL:");
! 106: static int waitpid_asleep = 0;
! 107:
! 108: static void
! 109: popen_completion_ast(unsigned long int unused)
! 110: {
! 111: if (waitpid_asleep) {
! 112: waitpid_asleep = 0;
! 113: sys$wake(0,0);
! 114: }
! 115: }
! 116:
! 117: FILE *
! 118: popen(char *cmd, char *mode)
! 119: {
! 120: static char mbxname[64];
! 121: unsigned short int chan;
! 122: unsigned long int flags=1; /* nowait - gnu c doesn't allow &1 */
! 123: struct pipe_details *info;
! 124: struct dsc$descriptor_s namdsc = {sizeof mbxname, DSC$K_DTYPE_T,
! 125: DSC$K_CLASS_S, mbxname},
! 126: cmddsc = {0, DSC$K_DTYPE_T,
! 127: DSC$K_CLASS_S, 0};
! 128: unsigned long sts;
! 129:
! 130: if (!(info=malloc(sizeof(struct pipe_details))))
! 131: {
! 132: ERROR("Cannot malloc space");
! 133: return NULL;
! 134: }
! 135:
! 136: info->completion=0; /* I assume this will remain 0 until terminates */
! 137:
! 138: /* create mailbox */
! 139: create_mbx(&chan,&namdsc);
! 140:
! 141: /* open a FILE* onto it */
! 142: info->fp=fopen(mbxname, mode);
! 143:
! 144: /* give up other channel onto it */
! 145: _cksts(sys$dassgn(chan));
! 146:
! 147: if (!info->fp)
! 148: return NULL;
! 149:
! 150: cmddsc.dsc$w_length=strlen(cmd);
! 151: cmddsc.dsc$a_pointer=cmd;
! 152:
! 153: if (strcmp(mode,"r")==0) {
! 154: _cksts(lib$spawn(&cmddsc, &nl_desc, &namdsc, &flags,
! 155: 0 /* name */, &info->pid, &info->completion,
! 156: 0, popen_completion_ast,0,0,0,0));
! 157: }
! 158: else {
! 159: _cksts(lib$spawn(&cmddsc, &namdsc, 0 /* sys$output */, &flags,
! 160: 0 /* name */, &info->pid, &info->completion));
! 161: }
! 162:
! 163: info->next=open_pipes; /* prepend to list */
! 164: open_pipes=info;
! 165:
! 166: return info->fp;
! 167: }
! 168:
! 169: int pclose(FILE *fp)
! 170: {
! 171: struct pipe_details *info, *last = NULL;
! 172: unsigned long int abort = SS$_TIMEOUT, retsts;
! 173: unsigned long sts;
! 174:
! 175: for (info = open_pipes; info != NULL; last = info, info = info->next)
! 176: if (info->fp == fp) break;
! 177:
! 178: if (info == NULL)
! 179: /* get here => no such pipe open */
! 180: FATAL("pclose() - no such pipe open ???");
! 181:
! 182: if (!info->completion) { /* Tap them gently on the shoulder . . .*/
! 183: _cksts(sys$forcex(&info->pid,0,&abort));
! 184: sleep(1);
! 185: }
! 186: if (!info->completion) /* We tried to be nice . . . */
! 187: _cksts(sys$delprc(&info->pid));
! 188:
! 189: fclose(info->fp);
! 190: /* remove from list of open pipes */
! 191: if (last) last->next = info->next;
! 192: else open_pipes = info->next;
! 193: retsts = info->completion;
! 194: free(info);
! 195:
! 196: return retsts;
! 197: } /* end of pclose() */
! 198:
! 199:
! 200: /* sort-of waitpid; use only with popen() */
! 201: /*{{{unsigned long int waitpid(unsigned long int pid, int *statusp, int flags)*/
! 202: unsigned long int
! 203: waitpid(unsigned long int pid, int *statusp, int flags)
! 204: {
! 205: struct pipe_details *info;
! 206: unsigned long int abort = SS$_TIMEOUT;
! 207: unsigned long sts;
! 208:
! 209: for (info = open_pipes; info != NULL; info = info->next)
! 210: if (info->pid == pid) break;
! 211:
! 212: if (info != NULL) { /* we know about this child */
! 213: while (!info->completion) {
! 214: waitpid_asleep = 1;
! 215: sys$hiber();
! 216: }
! 217:
! 218: *statusp = info->completion;
! 219: return pid;
! 220: }
! 221: else { /* we haven't heard of this child */
! 222: $DESCRIPTOR(intdsc,"0 00:00:01");
! 223: unsigned long int ownercode = JPI$_OWNER, ownerpid, mypid;
! 224: unsigned long int interval[2];
! 225:
! 226: _cksts(lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0));
! 227: _cksts(lib$getjpi(&ownercode,0,0,&mypid,0,0));
! 228: if (ownerpid != mypid)
! 229: FATAL("pid not a child");
! 230:
! 231: _cksts(sys$bintim(&intdsc,interval));
! 232: while ((sts=lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0)) & 1) {
! 233: _cksts(sys$schdwk(0,0,interval,0));
! 234: _cksts(sys$hiber());
! 235: }
! 236: _cksts(sts);
! 237:
! 238: /* There's no easy way to find the termination status a child we're
! 239: * not aware of beforehand. If we're really interested in the future,
! 240: * we can go looking for a termination mailbox, or chase after the
! 241: * accounting record for the process.
! 242: */
! 243: *statusp = 0;
! 244: return pid;
! 245: }
! 246:
! 247: } /* end of waitpid() */
! 248:
! 249: #endif /* PIPES */
! 250:
! 251:
! 252: /* vax c doesn't come with strftime - watch out for redefn of RCSid */
! 253: #ifdef VAXCRTL
! 254: # define RCSid RCSid2
! 255: # include "strftime.c"
! 256: #endif
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to vms.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / gnuplot