SUBROUTINE ENDD 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(7)=FREQ(7)+1 IF(INDEX(IS,'.END') .NE. 0) GO TO 830 IF(INDEX(IS,'.ENDM') .NE. 0) GO TO 830 IF(INDEX(IS,'.ENDC') .NE. 0) GO TO 830 TPER=TPER-1 CALL CHECK(1) CALL SCOPY(TS(1,TPER),TNS,11,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #9',ES,131) LOGICAL ERR BPER=BPER-1 CALL CHECK(0) CALL SCOPY(BS(1,BPER),LNS,11,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #10',ES,131) IF(ISCOMP('bgn',TNS) .NE. 0) GO TO 4030 ES(1)=0 CALL CONCAT(LNS,':',ES,131) CALL OUTPUT RETURN 4030 IF(ISCOMP('rpt',TNS) .NE. 0) GO TO 4050 CALL SCOPY('.Error UNTIL(B) Expected',ES) CALL OUTPUT RETURN 4050 IF(ISCOMP('thr',TNS) .NE. 0) GO TO 4070 JPER=JPER-1 CALL SCOPY(JS(1,JPER),JNS,11,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #11',ES,131) CALL THROUT ES(1)=0 CALL CONCAT('sob ',JNS,ES,131) CALL CONCAT(ES,',',ES,131) CALL CONCAT(ES,BS(1,BPER),ES,131) CALL OUTPUT ES(1)=0 CALL CONCAT(LNS,':',ES,131) CALL OUTPUT RETURN 4070 IF(ISCOMP('for',TNS) .NE. 0) GO TO 4300 CALL SCOPY(JS(1,JPER-1),AFS,19,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #12',ES,131) CALL SCOPY(JS(1,JPER-2),ATS,19,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #13',ES,131) CALL SCOPY(JS(1,JPER-3),AOS,29,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #14',ES,131) CALL SCOPY(JS(1,JPER-4),ATHS,19,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #15',ES,131) JPER=JPER-4 ES(1)=0 CALL CONCAT('add ',AFS,ES,131) CALL CONCAT(ES,',',ES,131) CALL CONCAT(ES,AOS,ES,131) BNS(1)=' ' BNS(2)=0 CALL INOP CALL OUTPUT ES(1)=0 CALL CONCAT('cmp ',AOS,ES,131) CALL CONCAT(ES,',',ES,131) CALL CONCAT(ES,ATS,ES,131) CALL OUTPUT IF(ISCOMP(ATHS,'DOWNTO') .NE. 0) GO TO 4150 CALL SCOPY('bge .+4',ES) CALL OUTPUT GO TO 4160 4150 CALL SCOPY('ble .+4',ES) CALL OUTPUT 4160 CALL SCOPY('br .+6',ES) CALL OUTPUT CALL THROUT ES(1)=0 CALL CONCAT('jmp ',BS(1,BPER),ES,131) CALL OUTPUT ES(1)=0 CALL CONCAT(LNS,':',ES,131) CALL OUTPUT RETURN 4300 IF(ISCOMP(TNS,'if') .NE. 0) GO TO 4320 ES(1)=0 CALL CONCAT(LNS,':',ES,131) CALL OUTPUT RETURN 4320 IF(ISCOMP(TNS,'els') .NE. 0) GO TO 4340 ES(1)=0 CALL CONCAT(LNS,':',ES,131) CALL OUTPUT RETURN 4340 IF(ISCOMP(TNS,'whl') .NE. 0) GO TO 4360 CALL THROUT ES(1)=0 CALL CONCAT('jmp ',BS(1,BPER),ES,131) CALL OUTPUT ES(1)=0 CALL CONCAT(LNS,':',ES,131) CALL OUTPUT RETURN 4360 IF(ISCOMP(TNS,'cse') .NE. 0) GO TO 4380 ES(1)=0 CALL CONCAT(LNS,':',ES,131) CALL OUTPUT CFPER=0 RETURN 4380 IF(ISCOMP(TNS,'lop') .NE. 0) GO TO 4480 BPER=BPER-1 CALL CHECK(0) ES(1)=0 CALL CONCAT('jmp ',BS(1,BPER),ES,131) CALL OUTPUT ES(1)=0 CALL CONCAT(LNS,':',ES,131) CALL OUTPUT RETURN 4480 TYPE 100,LFPER CALL SCOPY('.Error END is not the end of a block',ES) CALL OUTPUT RETURN 100 FORMAT(1X,'END is not the end of a legal block in line',I6) 830 CALL SCOPY(IS,ES,131,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #16',ES,131) CALL OUTPUT CALL REGFET RETURN END