SUBROUTINE CASE 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,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(4)=FREQ(4)+1 LOGICAL*1 TMPS(60) CALL LABGEN CALL SCOPY(LS,BS(1,BPER),6,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #4',ES,131) LOGICAL ERR BPER=BPER+1 CALL SCOPY('cse ',TS(1,TPER)) TPER=TPER+1 ES(1)=0 CALL CONCAT('mov #',ls,es,131) CALL CONCAT(ES,',-(SP)',ES,131) CALL OUTPUT PPER=INDEX(IS,'CASEB') CALL SCOPY('mov ',ES) IF(PPER .NE. 0) GO TO 7050 CALL CONCAT(ES,' ',ES,131) GO TO 7060 7050 CALL CONCAT(ES,'b ',ES,131) 7060 PPER=INDEX(IS,' ') IF(PPER .NE. 0) GO TO 7090 CALL SCOPY('.Error Malformed CASE statement',ES) CALL OUTPUT RETURN 7090 POPER=INDEX(IS,' ',PPER+1) IF(POPER .EQ. 0) POPER=LEN(IS)+1 CALL LABGEN CALL SEG(IS,TMPS,PPER+1,POPER-1) CALL CONCAT(TMPS,',',TMPS,59) CALL CONCAT(TMPS,LS,TMPS,59) CALL CONCAT(ES,TMPS,ES,131) CALL OUTPUT ES(1)=0 CALL CONCAT('asl ',LS,ES,131) CALL OUTPUT CALL CONCAT('asl ',LS,ES,131) CALL OUTPUT CALL SCOPY(LS,LNS,11,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #5',ES,131) CALL LABGEN ES(1)=0 CALL CONCAT('add #',LS,ES,131) CALL CONCAT(ES,',',ES,131) CALL CONCAT(ES,LNS,ES,131) CALL OUTPUT CALL SCOPY('137 ;jmp @#',ES) CALL OUTPUT ES(1)=0 CALL CONCAT(LNS,':0',ES,131) CALL OUTPUT ES(1)=0 CALL CONCAT(LS,':',ES,131) CALL OUTPUT CFPER=1 RETURN END