SUBROUTINE UTILTY 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 C IMPLICIT BYTE (A-H,O-Z) INTEGER FREQ LOGICAL*1 OS,BS,JS,KS,TS,RNS,AS,ES,FS,IS,LS,QS,RS,ZS,FOS LOGICAL*1 ZOS,ZTS,CNS,FTS,OTS,OTHS,ROS,ONS,ETS,AZS,AOS LOGICAL*1 ATS,ATHS,AFS,AFIS,ASS,ASES,AEIS,EOS,BNS,EFS,FFS,ENS LOGICAL*1 IOS,JNS,OOS,LNS,TFS,TNS,XS,IFS,TMPS(15),OFS INTEGER PPER,BPER,MTPER,TPER,JPER,ENPER,UNPER,FNPER,BFPER INTEGER CFPER,KOPER,JFPER,KFPER,LFPER,POPER,PTPER,NEIPER INTEGER NNPER,TFPER,TFIPER,RNPER,HPER,KPER,MPER,FNIPER,SPER COMMON /DEC/ OS(4,16,2),BS(7,150),JS(30,70),KS(11,50), 1TS(5,150),RNS(3,50), 1 AS(4),ES(132),FS(12),IS(80),LS(80),QS(16),RS(12), + ZS(132), 1 FOS(12),UOS,ZOS(72),ZTS(72),CNS(4), 1 OTS(20),OTHS(20),ROS(10),ONS(26),FTS(52), + ETS(76),EFIS(46),FREQ(76), 1 AZS(20),AOS(30),ATS(20),ATHS(20),AFS(20), 1 AFIS(20),ASS(20), 1 ASES(20),AEIS(20),EOS(30),BNS(12),EFS(12), + FFIS(12),ENS(12), 1 IOS(12),JNS(12),OOS(20),LNS(12),TFIS(12),TNS(12), + XS(12),IFS(15),OFS(15), 1 PPER,BPER,MTPER,TPER,JPER,ENPER,UNPER,FNPER, + BFPER, 1 CFPER,KOPER,JFPER,KFPER,LFPER,POPER,PTPER,NEIPER, 1 NNPER,TFPER,TFIPER,RNPER,HPER,KPER,MPER,FNIPER,SPER INTEGER *4 UOS FREQ(47)=FREQ(47)+1 CALL LABGEN CALL SCOPY(LS,FFIS,11,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #55',ES,131) LOGICAL ERR CALL LABGEN CALL SCOPY(LS,TFIS,11,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #56',ES,131) CALL SCOPY(' ',AOS) CALL SEG(QS,TMPS,LEN(QS),LEN(QS)) IF(ISCOMP(TMPS,'B') .EQ. 0) CALL SCOPY('b',AOS) PPER=INDEX(IS,' ') IF(PPER .EQ. 0) GO TO 9950 CALL SEG(IS,IS,PPER+1,LEN(IS)) 10060 CALL UTIL PPER=INDEX(IS,' ') IF(PPER .EQ. 0) PPER=LEN(IS)+1 CALL SEG(IS,QS,1,PPER-1) CALL SEG(IS,IS,PPER+1,LEN(IS)) IF(ISCOMP(QS,'AND') .NE. 0) GO TO 10100 ES(1)=0 CALL CONCAT(TFIS,':',ES,131) CALL OUTPUT CALL LABGEN CALL SCOPY(' ',AOS) 10080 CALL SCOPY(LS,TFIS,11,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #57',ES,131) GO TO 10060 10100 IF(ISCOMP(QS,'ANDB') .NE. 0) GO TO 10110 ES(1)=0 CALL CONCAT(TFIS,':',ES,131) CALL OUTPUT CALL LABGEN CALL SCOPY('b',AOS) GO TO 10080 10110 IF(ISCOMP(QS,'OR') .NE. 0) GO TO 10120 ES(1)=0 CALL CONCAT(FFIS,':',ES,131) CALL OUTPUT CALL LABGEN CALL SCOPY(' ',AOS) 10115 CALL SCOPY(LS,FFIS,11,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #58',ES,131) GO TO 10060 10120 IF(ISCOMP(QS,'ORB') .NE. 0) GO TO 10130 ES(1)=0 CALL CONCAT(FFIS,':',ES,131) CALL OUTPUT CALL LABGEN CALL SCOPY('b',AOS) GO TO 10115 10130 GO TO (10140,10150,10160),KFPER 10140 IF(ISCOMP(QS,'THEN') .EQ. 0) GO TO 10200 CALL SCOPY('.Error- THEN expected',ES) CALL OUTPUT RETURN 10150 IF(LEN(IS) .EQ. 0) GO TO 10500 CALL SCOPY('.Error Illegal expression after UNTIL',ES) CALL OUTPUT RETURN 10160 IF((ISCOMP(QS,'DO') .EQ. 0) .OR. (LEN(IS) .EQ. 0)) GO TO 10300 CALL SCOPY('.Error-DO expected',ES) CALL OUTPUT RETURN 10200 CALL SCOPY(FFIS,BS(1,BPER),6,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #59',ES,131) BPER=BPER+1 ES(1)=0 CALL CONCAT(TFIS,': ',ES,131) CALL OUTPUT RETURN 10300 ES(1)=0 CALL CONCAT(FFIS,': jmp ',ES) CALL CONCAT(ES,BS(1,BPER-1),ES) CALL OUTPUT ES(1)=0 CALL CONCAT(TFIS,':',ES,131) CALL OUTPUT RETURN 10500 ES(1)=0 CALL CONCAT(TFIS,': br ',ES,131) CALL CONCAT(ES,LNS,ES,131) CALL OUTPUT CALL CONCAT(FFIS,': jmp ',ES,131) CALL CONCAT(ES,BS(1,BPER-1),ES,131) CALL OUTPUT BPER=BPER-1 CALL CHECK(0) RETURN 9950 CALL SCOPY('.Error syntax error in logical expression',ES) CALL OUTPUT RETURN END