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