LOGICAL FUNCTION COMPRS(IN,NUM) C ************************************************** C * * C * S U P E R - M A C * C * * C * PREPROCESSOR * C * * C * FORTRAN VERSION * C * * C * AUTHORS: Thomas J. Weslowski * C * Computer Science Dept. * C * SUNY at Oswego * C * Oswego, NY 13126 * C * * C * and * C * * C * Richard R. DeMidio * C * Instructional Comp. Ctr. * C * Snygg Hall * C * SUNY at Oswego * C * Oswego, NY 13126 * C * * C * MAINTAINER: Edward F. Beadel, Jr. * C * Manager * C * Instructional Comp. Ctr. * C * Snygg Hall * C * SUNY at Oswego * C * Oswego, NY 13126 * C * * C * PHONE: (315) 341-3305 * C * * C ************************************************** C C C COPYRIGHT (c) 1981, 1982, 1983 C BY C Instructional Computing Center C State University of New York at Oswego C Oswego, NY 13126 C C contact: Edward F. Beadel, Jr., Manager C phone: 315/341-3055 C C C This software is furnished in an as-is condition, C with no committments of support or updates. This C software or any other copies thereof may NOT be C sold for profit nor can it be included in any C package to be sold for profit without the written C consent of the author and the coppyright owner. C This software may be used and copied only in ac- C cordance with the terms set forth above and with C the inclusion of the above copyright notice. C C The information in this software is subject C to change without notice and should not be con- C strued as a commitment by The State University of C New York, The C.A.U.S.E. Instructional Computing C Center, the author(s) or maintainer(s) of this C software. C C The State University of New York, The C C.A.U.S.E. Instructional Computing Center, the C author(s), and the maintainer(s) of this software C collectively and individually assume no responsi- C bility for the use or reliability of this C software. C C C C This neat little utility function will serve 2 main C functions. First, it will determine if a Supermac dir- C ective exists. If so, it will compress the string so C that only 1 blank is between terms of the statement. C Finally, the flag will be set indicating that a directive C has been found. C COMPRS declarations BYTE IN(80),TMP(80) INTEGER NUM,TPTR,K,I,P C COMPRS code COMPRS=.FALSE. TMP(1)=0 CALL TRIM(IN) DO 10 K=1,LEN(IN) IF((IN(K) .NE. ' ') .AND. (IN(K) .NE. ' ')) GOTO 15 TMP(K)=IN(K) TMP(K+1)=0 10 CONTINUE C Remove all trailing blanks. Then search for the C first non-blank character. In addition, start to C build up our new string in case a directive should C exist. 15 IF(IN(K) .NE. '#')RETURN TPTR=K DO 20 I=K,LEN(IN) IF((IN(I) .EQ. ' ') .AND. (IN(I+1) .EQ. ' '))GOTO 20 TMP(TPTR)=IN(I) TPTR=TPTR+1 TMP(TPTR)=0 20 CONTINUE C Check to see if we have a directive. If no, than we C will simply set our flag to false and return. However, C if true, we will parse the string removing all extraneous C blanks in order to build up our new string. GOTO (22,23) NUM+1 ! Include or Define?? 22 P=INDEX(TMP,'# INCLUDE') IF(P .EQ. 0) P=INDEX(TMP,'#INCLUDE') GOTO 25 23 P=INDEX(TMP,'# DEFINE') IF(P .EQ. 0) P=INDEX(TMP,'#DEFINE') 25 IF(P .GT. 0) COMPRS=.TRUE. CALL SCOPY(TMP,IN) RETURN C Determine which of directives we are looking for. C Then search for the appropiate directive and set C the flag. END