5 * Revision 1.4 1997/09/02 14:26:46 mclareni
8 * Revision 1.3 1997/02/04 17:35:11 mclareni
9 * Merge Winnt and 97a versions
11 * Revision 1.2 1997/01/15 16:25:32 cernlib
12 * fix from F.Hemmer to return rfio return code
14 * Revision 1.1.1.1.2.1 1997/01/21 11:30:10 mclareni
15 * All mods for Winnt 96a on winnt branch
17 * Revision 1.1.1.1 1996/02/15 17:49:36 mclareni
21 #include "kerngen/pilot.h"
22 #include "kerngen/fortranc.h"
24 #if defined(CERNLIB_QMOS9)
25 #include "os9gs/cfopei.c"
28 CERN PROGLIB# Z310 CFOPEI .VERSION KERNFOR 4.38 931108
30 CALL CFOPEN (LUNDES, MEDIUM, NWREC, MODE, NBUF, TEXT, ISTAT)
32 *LUNDES file descriptor
33 MEDIUM = 0,1,2,3 : primary disk/tape, secondary disk/tape
34 NWREC record length in number of words
35 MODE string selecting IO mode
36 = 'r ', 'w ', 'a ', 'r+ ', ...
37 NBUF number of buffers to be allocated, (not used)
39 *ISTAT status, =zero if success
41 #include "kerngen/cf_open.h"
43 #include "kerngen/cf_xaft.h"
44 #include "kerngen/fortchar.h"
45 #include "kerngen/wordsizc.h"
47 #if defined(CERNLIB_QX_SC)
48 void type_of_call cfopei_(lundes,medium,nwrec,mode,nbuf,ftext,stat,lgtx)
50 #if defined(CERNLIB_QXNO_SC)
51 void type_of_call cfopei(lundes,medium,nwrec,mode,nbuf,ftext,stat,lgtx)
53 #if defined(CERNLIB_QXCAPT)
54 # ifndef CERNLIB_MSSTDCALL
55 void type_of_call CFOPEI(lundes,medium,nwrec,mode,nbuf,ftext,stat,lgtx)
57 void type_of_call CFOPEI(lundes,medium,nwrec,mode,nbuf,ftext,len_ftext,stat,lgtx)
61 #if defined(CERNLIB_QMCRY)
64 #if !defined(CERNLIB_QMCRY)
67 int *lundes, *medium, *nwrec, *nbuf, *stat, *lgtx;
70 char *pttext, *fchtak();
87 if (*medium == 1) goto fltp;
88 if (*medium == 3) goto fltp;
96 else if (mode[0] == 1)
98 flags = O_WRONLY | O_CREAT | O_TRUNC;
100 flags = O_RDWR | O_CREAT | O_TRUNC;}
102 else if (mode[0] == 2)
104 flags = O_WRONLY | O_CREAT | O_APPEND;
106 flags = O_RDWR | O_CREAT | O_APPEND;}
111 fltp: if (mode[0] == 0)
117 else if (mode[0] == 1)
123 else if (mode[0] == 2) return;
127 act: pttext = fchtak(ftext,*lgtx);
128 if (pttext == 0) return;
130 if (perm == 0) perm = 0644;
132 #if defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
133 fildes = open (pttext, flags | O_BINARY, perm);
135 fildes = open (pttext, flags, perm);
137 if (fildes < 0) goto errm;
142 #if defined(CERNLIB_PROJSHIFT)
143 errm: *stat = (serrno ? serrno : (rfio_errno ? rfio_errno : errno));
147 perror (" error in CFOPEN");
152 /*> END <----------------------------------------------------------*/