00001 /* 00002 * Copyright 2003, 2004 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/s2ul.c 92.1 06/18/99 18:41:02" 00043 #include <fortran.h> 00044 #include <cray/fmtconv.h> 00045 00046 extern oc_func _S2UL; /* Interface must match oc_func prototype */ 00047 00048 /* 00049 * _S2UL() Convert Fortran logical variable to external format. 00050 * 00051 * Entry: 00052 * value Address of logical variable 00053 * fca Address of first unpacked character 00054 * mode Unused 00055 * width Field width 00056 * digits Unused 00057 * exp Unused 00058 * scale Unused 00059 * 00060 * Exit: 00061 * result Points to end of output field 00062 * 00063 * Note: This routine has the same parameters as S2UI, etc. in 00064 * libc. 00065 */ 00066 00067 long * 00068 _S2UL( 00069 const void *value, 00070 long *fca, 00071 const long *mode, 00072 const long *width, 00073 const long *digits, 00074 const long *exp, 00075 const long *scale 00076 ) 00077 { 00078 int i; 00079 long fw, *ptr; 00080 char ch; 00081 fw = *width - 1; 00082 #ifdef _F_LOG4 00083 if ((*mode & MODEHP) != 0) 00084 ch = _lvtob( *(_f_log4 *)value) ? 'T' : 'F'; 00085 else 00086 /* KEY: This used to have __mips */ 00087 #if defined(_F_LOG2) 00088 if ((*mode & MODEWP) != 0) { 00089 ch = _lvtob( *(_f_log2 *)value) ? 'T' : 'F'; 00090 } else if ((*mode & MODEBP) != 0) { 00091 ch = _lvtob( *(_f_log1 *)value) ? 'T' : 'F'; 00092 } else 00093 #endif /* _F_LOG2 and MIPS */ 00094 #endif /* _F_LOG4 */ 00095 { 00096 ch = _lvtob( *(_f_log8 *)value) ? 'T' : 'F'; 00097 } 00098 00099 /* The following loop should vectorize */ 00100 00101 for (i = 0; i < fw; i++) 00102 fca[i] = (long) ' '; 00103 00104 ptr = fca + fw; 00105 *ptr++ = (long) ch; 00106 00107 return (ptr); 00108 }
1.5.6