00001 /* 00002 * Copyright 2004, 2005 PathScale, Inc. All Rights Reserved. 00003 */ 00004 00005 /* 00006 00007 Copyright (C) 2000, 2001, Silicon Graphics, Inc. All Rights Reserved. 00008 00009 This program is free software; you can redistribute it and/or modify it 00010 under the terms of version 2.1 of the GNU Lesser General Public License 00011 as published by the Free Software Foundation. 00012 00013 This program is distributed in the hope that it would be useful, but 00014 WITHOUT ANY WARRANTY; without even the implied warranty of 00015 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00016 00017 Further, this software is distributed without any warranty that it is 00018 free of the rightful claim of any third person regarding infringement 00019 or the like. Any license provided herein, whether implied or 00020 otherwise, applies only to this software file. Patent licenses, if 00021 any, provided herein do not apply to combinations of this program with 00022 other software, or any other product whatsoever. 00023 00024 You should have received a copy of the GNU Lesser General Public 00025 License along with this program; if not, write the Free Software 00026 Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 00027 USA. 00028 00029 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00030 Mountain View, CA 94043, or: 00031 00032 http://www.sgi.com 00033 00034 For further information regarding this notice, see: 00035 00036 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00037 00038 */ 00039 00040 00041 00042 #pragma ident "@(#) libf/fio/fork.c 92.1 06/18/99 19:52:04" 00043 00044 /* 00045 * fork_ - forks a copy of this process 00046 * 00047 * calling sequence: 00048 * 00049 * INTEGER fork, ierror 00050 * ierror = fork() 00051 * where: 00052 * 00053 * ierror = child pid if parent and successful 00054 * = 0 if child 00055 * = -errno if unsuccessful 00056 * Entry point fork_ is called from f77 and from f90 when there is no 00057 * compatiblity module. 00058 * 00059 * Entry point forkf90_ is called from f90 when there is a 00060 * compatiblity module. 00061 * 00062 * Entry point forkf90_8_ is called from f90 when there is a 00063 * compatiblity module. 00064 */ 00065 00066 #include <sys/types.h> 00067 #include <unistd.h> 00068 #include <errno.h> 00069 #include <foreign.h> 00070 #include <liberrno.h> 00071 #include "fio.h" 00072 00073 extern void flush_connected_units (void); /* From F77 library */ 00074 extern int fork_(void); 00075 extern _f_int forkf90_(void); 00076 extern _f_int8 forkf90_8_(void); 00077 00078 void _flushall(void); 00079 00080 #if defined(_LITTLE_ENDIAN) 00081 00082 int 00083 fork_(void) 00084 { 00085 forkf90_(); 00086 } 00087 00088 #else 00089 00090 int 00091 fork_(void) 00092 { 00093 /* this should work if f77 -craylibs used or if f90 used. */ 00094 void _flushall(void); 00095 00096 /* defined in libI77/open.c and called from fork_ . 00097 * This should get an error if used from fortran 90 00098 * according to libu77/externals.h but should work 00099 * from Fortran77. 00100 * 00101 */ 00102 flush_connected_units(); 00103 00104 /* fork a copy of this process */ 00105 return( fork() ); 00106 } 00107 00108 #endif 00109 00110 _f_int 00111 forkf90_(void) 00112 { 00113 /* this should work if f77 -craylibs used or if f90 used. */ 00114 _flushall(); 00115 00116 /* fork a copy of this process */ 00117 return( fork() ); 00118 } 00119 00120 _f_int8 00121 forkf90_8_(void) 00122 { 00123 /* this should work if f77 -craylibs used or if f90 used. */ 00124 _flushall(); 00125 00126 /* fork a copy of this process */ 00127 return( fork() ); 00128 } 00129 00130 /* 00131 * _flushall - flush all connected Fortran units except 100, 101, 102. 00132 */ 00133 void 00134 _flushall(void) 00135 { 00136 int ret; 00137 register short errflag; 00138 static short pass = 0; /* incremented when _flushall is called */ 00139 unit *uptr; 00140 00141 if (pass++ >= 1) 00142 return; 00143 00144 errflag = 0; 00145 /* 00146 * Find all open Fortran units not connected by 00147 * WOPEN/OPENMS/OPENDR/AQOPEN and flush them. 00148 */ 00149 uptr = _get_next_unit(NULL, 0, 0); 00150 00151 while (uptr != NULL) { /* while more open units */ 00152 #ifdef KEY /* Bug 6433 */ 00153 _f_int4 unum; 00154 #else /* KEY Bug 6433 */ 00155 unum_t unum; 00156 #endif /* KEY Bug 6433 */ 00157 00158 unum = uptr->uid; 00159 00160 if (OPEN_UPTR(uptr) && uptr->ufs != FS_AUX) { 00161 flush_( &unum ); 00162 } 00163 uptr = _get_next_unit(uptr, 0, 0); 00164 } 00165 /* 00166 * Flush C files on mips because the C cleanup routine will not 00167 * be executed if the code is loaded using the f90 command. So 00168 * Fortran fork_ processing must flush stdout and any user C 00169 * files in addition to the Fortran files. 00170 */ 00171 (void) fflush(NULL); 00172 return; 00173 }
1.5.6