Annotation of OpenXM_contrib/gnuplot/vms.c, Revision 1.1.1.2
1.1 maekawa 1: #ifndef lint
1.1.1.2 ! maekawa 2: static char *RCSid = "$Id: vms.c,v 1.6 1998/11/20 12:14:51 lhecking Exp $";
1.1 maekawa 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