Open64: osprey/libF77/s_srng.c Source File

00001 /*
00002  * Copyright 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 /* $Header: /proj/osprey/CVS/open64/osprey1.0/libF77/s_srng.c,v 1.1.1.1 2005/10/21 19:00:00 marcel Exp $ */
00042 #include <stdio.h>
00043 #include "cmplrs/host.h"
00044 
00045 
00046 /* called when a substring lower bound is out of range */
00047 
00048 void
00049 s_srng(char *varn, int32 lower, int32 upper, char *procn, int32 line)
00050 {
00051   register int32 i;
00052   extern void s_abort(int32);
00053 
00054   fprintf(stderr, "Substring bound(s) out of range on file line %d, procedure ", line);
00055   for(i = 0 ; i < 8 && *procn!='_' ; ++i)
00056     putc(*procn++, stderr);
00057   fprintf(stderr, ".\nAttempt to access the %d-th through the %d-th characters of variable ", lower, upper);
00058   for(i = 0 ; i < 6  && *varn!=' ' ; ++i)
00059     putc(*varn++, stderr);
00060   fprintf(stderr, ".\n");
00061   s_abort(99);
00062 }