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 #pragma ident "@(#) libf/pxf/pxflink.c 92.1 06/29/99 11:36:06" 00038 00039 #include <errno.h> 00040 #include <fortran.h> 00041 #include <liberrno.h> 00042 #include <malloc.h> 00043 #include <string.h> 00044 #include <unistd.h> 00045 00046 extern char *_fc_acopy(_fcd f); 00047 00048 /* 00049 * PXFLINK Create a link to a file 00050 * 00051 * Call from Fortran: 00052 * 00053 * SUBROUTINE PXFLINK (EXIST, LENEXST, NEW, LENNEW, IERROR) 00054 * CHARACTER * (*) EXIST, NEW 00055 * INTEGER LENEXST, LENNEW, IERROR 00056 * 00057 * Where: 00058 * 00059 * EXIST is an input character variable or array element 00060 * containing the name of a file that exists. 00061 * 00062 * LENEXST is an input integer variable containing the length 00063 * of EXIST in characters. If ILEN is zero, any and 00064 * all trailing blanks are removed. 00065 * 00066 * NEW is an input character variable or array element 00067 * containing the name of a new file. 00068 * 00069 * LENNEW is an input integer variable containing the length 00070 * of NEW in characters. If ILEN is zero, any and 00071 * all trailing blanks are removed. 00072 * 00073 * IERROR is an output integer variable that will contain the 00074 * status: Zero if PXFLINK is successful; otherwise 00075 * nonzero. 00076 * 00077 * In addition to the error statuses returned by the 00078 * link(2) system call, PXFLINK may return the 00079 * following error statuses: 00080 * 00081 * EINVAL If ILEN < 0 or ILEN > LEN(PATH) 00082 * 00083 * ENOMEM If PXFLINK is unable to obtain memory to 00084 * copy EXIST or NEW. 00085 */ 00086 00087 #ifdef _UNICOS 00088 void 00089 PXFLINK( 00090 #else 00091 void 00092 _PXFLINK( 00093 #endif 00094 _fcd EXISTF, /* Current file Name */ 00095 _f_int *LENEX, /* Length of EXISTF name or zero */ 00096 _fcd NEWF, /* New file Name */ 00097 _f_int *LENNEW, /* Length of NEWF name or zero */ 00098 _f_int *IERROR /* Error status */ 00099 ) 00100 { 00101 int arglenex, lengex; 00102 int arglennew, lengnew; 00103 int errsts; 00104 char *argstrex, *pthstrex; 00105 char *argstrnew, *pthstrnew; 00106 00107 errsts = 0; 00108 argstrex = _fcdtocp(EXISTF); 00109 arglenex = (int)_fcdlen (EXISTF); 00110 lengex = *LENEX; 00111 argstrnew = _fcdtocp(NEWF); 00112 arglennew = (int)_fcdlen (NEWF); 00113 lengnew = *LENNEW; 00114 00115 if ((lengex < 0 || lengex > arglenex) || 00116 ((lengnew < 0 || lengnew > arglennew))) 00117 errsts = EINVAL; 00118 else { 00119 00120 /* 00121 * If length is zero, user wants trailing blanks stripped. 00122 * Otherwise, malloc memory and copy the string; adding a 00123 * NULL terminator. 00124 */ 00125 00126 if (lengex == 0) 00127 pthstrex = _fc_acopy(EXISTF); 00128 else 00129 pthstrex = (char *) malloc(lengex + 1); 00130 00131 if (lengnew == 0) 00132 pthstrnew = _fc_acopy(NEWF); 00133 else 00134 pthstrnew = (char *) malloc(lengnew + 1); 00135 00136 /* if no memory allocated */ 00137 if (pthstrex == NULL || pthstrnew == NULL) { 00138 errsts = ENOMEM; 00139 if (pthstrex != NULL) 00140 free(pthstrex); 00141 if (pthstrnew != NULL) 00142 free(pthstrnew); 00143 } else { 00144 if (lengex != 0) { /* Copy argument */ 00145 (void) memcpy(pthstrex, argstrex, lengex); 00146 pthstrex[lengex] = '\0'; 00147 } 00148 if (lengnew != 0) { /* Copy argument */ 00149 (void) memcpy(pthstrnew, argstrnew, lengnew); 00150 pthstrnew[lengnew] = '\0'; 00151 } 00152 00153 /* link the files */ 00154 00155 if (link(pthstrex,pthstrnew) == -1) 00156 errsts = errno; 00157 00158 free(pthstrex); 00159 free(pthstrnew); 00160 } 00161 } 00162 *IERROR = errsts; 00163 return; 00164 } 00165 00166 00167 #ifndef _UNICOS 00168 void 00169 pxflink_( 00170 char *EXISTF, /* Current file Name */ 00171 _f_int *LENEX, /* Length of EXISTF name or zero */ 00172 char *NEWF, /* New file Name */ 00173 _f_int *LENNEW, /* Length of NEWF name or zero */ 00174 _f_int *IERROR, /* Error status */ 00175 _f_int existflen, 00176 _f_int newflen 00177 ) 00178 { 00179 _PXFLINK(_cptofcd(EXISTF,existflen), LENEX, _cptofcd(NEWF, newflen), 00180 LENNEW, IERROR); 00181 } 00182 #endif
1.5.6