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 /* $Header: /m_home/m_utkej/Argonne/cvs2svn/cvs/Open64/osprey1.0/libF77/s_cat_kai.c,v 1.1.1.1 2002-05-22 20:09:13 dsystem Exp $ */ 00038 00039 #include <stdio.h> 00040 #include <string.h> 00041 #include <stdlib.h> 00042 #include "cmplrs/host.h" 00043 00044 extern void f77fatal (int32, char *); 00045 00046 #define BUFSIZE ((size_t)8192) 00047 typedef struct { 00048 struct bufstruct *next; 00049 size_t len_so_far; 00050 } OVERHEAD; 00051 00052 typedef char BUF[ BUFSIZE - sizeof(OVERHEAD) ]; 00053 00054 typedef struct bufstruct { 00055 OVERHEAD header; 00056 BUF buffer; 00057 } KAI_MARKED_HEAP; 00058 00059 00060 /* The following three variables need to be in processor-private memory */ 00061 static KAI_MARKED_HEAP *KAI_heap_stack = NULL; 00062 static size_t len_used = 0; 00063 00064 size_t _kai_mhalloc_tos_ = 0; 00065 00066 /* The linkage name "_kai_mhalloc_tos_" is shared with Fortran-generated object codes. */ 00067 /* Restoring a previously saved value of _kai_mhalloc_tos_ sets up a lazy "deallocate" */ 00068 /* of all the regions mhalloc'ed since that value was saved. This discipline is often */ 00069 /* described as a "marked heap". */ 00070 00071 /* The following routine allocates len bytes on this processor's marked heap. */ 00072 /* The byte beyond the mhalloc'ed region is ascii NUL. */ 00073 00074 char * 00075 kai_mhalloc( size_t len ) 00076 { 00077 size_t n; 00078 char *result; 00079 KAI_MARKED_HEAP *nxtbuf; 00080 00081 if (_kai_mhalloc_tos_ < len_used) { 00082 while (_kai_mhalloc_tos_ < KAI_heap_stack->header.len_so_far) { 00083 nxtbuf = KAI_heap_stack->header.next; 00084 free( KAI_heap_stack ); 00085 KAI_heap_stack = nxtbuf; 00086 } 00087 len_used = _kai_mhalloc_tos_; 00088 } 00089 00090 len++; /* Put ascii NUL at end to help F77/C interfaces */ 00091 if (KAI_heap_stack) { 00092 n = len_used - KAI_heap_stack->header.len_so_far; 00093 if (len + n <= sizeof( BUF )) { 00094 result = KAI_heap_stack->buffer + n; 00095 } else { 00096 n = len + sizeof( OVERHEAD ); /* shipping and handling */ 00097 nxtbuf = (KAI_MARKED_HEAP *) malloc( n < BUFSIZE ? BUFSIZE : n ); 00098 if (!nxtbuf) f77fatal(113,"mhalloc"); 00099 len_used++; /* freedom isn't free */ 00100 nxtbuf->header.next = KAI_heap_stack; 00101 nxtbuf->header.len_so_far = len_used; 00102 KAI_heap_stack = nxtbuf; 00103 result = KAI_heap_stack->buffer; 00104 } 00105 } else { 00106 len_used = (len > sizeof( BUF )); /* Permit leading big BUF to be free'd */ 00107 if (len_used) { 00108 n = len + sizeof( OVERHEAD ); /* shipping and handling */ 00109 KAI_heap_stack = (KAI_MARKED_HEAP *) malloc( n ); 00110 } else { 00111 KAI_heap_stack = (KAI_MARKED_HEAP *) malloc( BUFSIZE ); 00112 } 00113 if (!KAI_heap_stack) f77fatal(113,"mhalloc"); 00114 KAI_heap_stack->header.next = NULL; 00115 KAI_heap_stack->header.len_so_far = len_used; 00116 result = KAI_heap_stack->buffer; 00117 } 00118 00119 len_used += len; 00120 *(result + len) = '\0'; 00121 00122 _kai_mhalloc_tos_ = len_used; 00123 return result; 00124 } 00125 00126 00127 string 00128 s_cat_kai( string strings[], fsize_t lengths[], int32 count, fsize_t *result_len) 00129 { 00130 int32 i; 00131 size_t len = 0; 00132 string tmpbuf; 00133 string result; 00134 00135 i = count; 00136 while (i--) len += lengths[i]; 00137 *result_len = len; 00138 00139 tmpbuf = result = kai_mhalloc( len ); 00140 00141 for (i = 0; i < count ; ++i) { 00142 memcpy (tmpbuf, strings[i], lengths[i]); 00143 tmpbuf += lengths[i]; 00144 } 00145 00146 return result; 00147 } 00148