00001 /* 00002 * Copyright 2004, 2005, 2006 PathScale, Inc. All Rights Reserved. 00003 */ 00004 00005 /* Copyright (C) 1995 Free Software Foundation, Inc. 00006 This file is part of GNU Fortran libU77 library. 00007 00008 This library is free software; you can redistribute it and/or modify it 00009 under the terms of the GNU Library General Public License as published 00010 by the Free Software Foundation; either version 2 of the License, or 00011 (at your option) any later version. 00012 00013 GNU Fortran is distributed in the hope that it will be useful, 00014 but WITHOUT ANY WARRANTY; without even the implied warranty of 00015 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 00016 Library General Public License for more details. 00017 00018 You should have received a copy of the GNU Library General Public 00019 License along with GNU Fortran; see the file COPYING.LIB. If 00020 not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 00021 Boston, MA 02111-1307, USA. */ 00022 00023 #include "config.h" 00024 #if HAVE_STDLIB_H || defined(KEY) /* Bug 1683, 5019 */ 00025 # include <stdlib.h> 00026 #endif 00027 #ifdef KEY /* Bug 5019 */ 00028 #include "cray/mtlock.h" 00029 #include "pathf90_libU_intrin.h" 00030 #endif /* KEY Bug 5019 */ 00031 00032 #include "f2c.h" 00033 00034 /* We could presumably do much better than the traditional libc 00035 version, though at least the glibc one is reasonable, it seems. 00036 For the sake of the innocent, I'm not sure we should really do 00037 this... */ 00038 00039 /* Note this is per SunOS -- other s may have no arg. */ 00040 00041 integer 00042 G77_irand_0 (integer * flag) 00043 { 00044 #ifdef KEY /* Bug 1683, 5019 */ 00045 /* Experiment shows that g77 generates a zero (outside the library, 00046 * apparently) when the optional "flag" argument is missing */ 00047 integer zero = 0; 00048 flag = (0 == flag) ? (&zero) : flag; 00049 MEM_LOCK(&pathf90_rand_mutex); 00050 switch (*flag) 00051 { 00052 case 0: 00053 break; 00054 case 1: 00055 srand (0); /* Arbitrary choice of initialiser. */ 00056 break; 00057 default: 00058 srand (*flag); 00059 } 00060 integer result = rand (); 00061 MEM_UNLOCK(&pathf90_rand_mutex); 00062 return result; 00063 #else 00064 switch (*flag) 00065 { 00066 case 0: 00067 break; 00068 case 1: 00069 srand (0); /* Arbitrary choice of initialiser. */ 00070 break; 00071 default: 00072 srand (*flag); 00073 } 00074 return rand (); 00075 #endif /* KEY Bug 1683, 5019 */ 00076 }
1.5.6