xref: /csrg-svn/usr.bin/f77/libF77/subout.c (revision 47940)
1*47940Sbostic /*-
2*47940Sbostic  * Copyright (c) 1980 The Regents of the University of California.
3*47940Sbostic  * All rights reserved.
422988Skre  *
5*47940Sbostic  * %sccs.include.proprietary.c%
610547Sdlw  */
710547Sdlw 
8*47940Sbostic #ifndef lint
9*47940Sbostic static char sccsid[] = "@(#)subout.c	5.2 (Berkeley) 04/12/91";
10*47940Sbostic #endif /* not lint */
11*47940Sbostic 
1210547Sdlw #include <stdio.h>
1310547Sdlw 
subout(varn,offset,procn,line)1410547Sdlw subout(varn, offset, procn, line)
1510547Sdlw char *varn, *procn;
1610547Sdlw long int offset;
1710547Sdlw int line;
1810547Sdlw {
1910547Sdlw register int i;
2010547Sdlw 
2110547Sdlw fprintf(stderr, "Subscript out of range on line %d of procedure ", line);
2210547Sdlw for(i = 0 ; i < 8 && *procn!='_' ; ++i)
2310547Sdlw 	putc(*procn++, stderr);
2410547Sdlw fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", offset+1);
2510547Sdlw for(i = 0 ; i < 6  && *varn!=' ' ; ++i)
2610547Sdlw 	putc(*varn++, stderr);
2710547Sdlw fprintf(stderr, ".\n");
2820187Slibs f77_abort();
2910547Sdlw }
30