SUBROUTINE LET 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(22)=FREQ(22)+1 CALL SEG(IS,AZS,1,INDEX(IS,' ',1)-1) IF(ISCOMP(AZS,'LETB') .NE. 0) GO TO 5020 CALL SCOPY('b',BNS) GO TO 5050 5020 IF(ISCOMP(AZS,'LET') .NE. 0) GO TO 5030 CALL SCOPY(' ',BNS) GO TO 5050 5030 CALL SCOPY('.Error unrecognizable LET statement',ES) CALL OUTPUT RETURN 5050 PPER=INDEX(IS,' ',2) POPER=INDEX(IS,' ',PPER+1) CALL SEG(IS,AOS,PPER+1,POPER-1) IF(LEN(AOS) .EQ. 0) GO TO 5030 PPER=INDEX(IS,' ',POPER+1) CALL SEG(IS,ATS,POPER+1,PPER-1) IF(ISCOMP(ATS,':=') .NE. 0) GO TO 5900 POPER=INDEX(IS,' ',PPER+1) IF(POPER .EQ. 0) POPER=LEN(IS)+1 CALL SEG(IS,ATHS,PPER+1,POPER-1) IF(LEN(ATHS) .EQ. 0) GO TO 5030 IF(ISCOMP(AOS,ATHS) .EQ. 0) GO TO 5250 IF(ISCOMP(ATHS,'TRUE') .NE. 0) GO TO 5180 ES(1)=0 CALL CONCAT('mov',BNS,ES,131) CALL CONCAT(ES,' #-1,',ES,131) CALL CONCAT(ES,AOS,ES,131) CALL OUTPUT GO TO 5250 5180 IF(ISCOMP(ATHS,'FALSE') .NE. 0) GO TO 5200 ES(1)=0 CALL CONCAT('clr',BNS,ES,131) CALL CONCAT(ES,' ',ES,131) CALL CONCAT(ES,AOS,ES,131) CALL OUTPUT GO TO 5250 5200 IF(ISCOMP(ATHS,'#0') .NE. 0) GO TO 5220 ES(1)=0 CALL CONCAT('clr',BNS,ES,131) CALL CONCAT(ES,' ',ES,131) CALL CONCAT(ES,AOS,ES,131) CALL OUTPUT GO TO 5250 5220 ES(1)=0 CALL CONCAT('mov',BNS,ES,131) CALL CONCAT(ES,' ',ES,131) CALL CONCAT(ES,ATHS,ES,131) CALL CONCAT(ES,',',ES,131) CALL CONCAT(ES,AOS,ES,131) CALL OUTPUT 5250 CALL SEG(IS,IOS,POPER+1,LEN(IS)) 5260 IF(LEN(IOS) .EQ. 0) RETURN PPER=INDEX(IOS,' ',2) IF(PPER .EQ. 0) PPER=LEN(IOS)+1 D IF(PPER .EQ. 0) RETURN CALL SEG(IOS,ATHS,1,PPER-1) POPER=INDEX(IOS,' ',PPER+1) IF(POPER .EQ. 0) POPER=LEN(IOS)+1 CALL SEG(IOS,AFS,PPER+1,POPER-1) CALL SEG(IOS,IOS,POPER+1,LEN(IOS)) IF(ISCOMP(ATHS,'+') .NE. 0) GO TO 5370 ES(1)=0 CALL CONCAT('add',BNS,ES,131) CALL CONCAT(ES,' ',ES,131) CALL CONCAT(ES,AFS,ES,131) CALL CONCAT(ES,',',ES,131) CALL CONCAT(ES,AOS,ES,131) 5360 CALL INOP CALL ILMATH 5365 CALL OUTPUT GO TO 5260 5370 IF(ISCOMP(ATHS,'-') .NE. 0) GO TO 5390 ES(1)=0 CALL CONCAT('sub',BNS,ES,131) CALL CONCAT(ES,AFS,ES,131) CALL CONCAT(ES,',',ES,131) CALL CONCAT(ES,AOS,ES,131) GO TO 5360 5390 IF(ISCOMP(ATHS,'*') .NE. 0) GO TO 5410 ES(1)=0 CALL CONCAT('mul',BNS,ES,131) CALL CONCAT(ES,AFS,ES,131) CALL CONCAT(ES,',',ES,131) CALL CONCAT(ES,AOS,ES,131) GO TO 5365 5410 IF(ISCOMP(ATHS,'/') .NE. 0) GO TO 5430 ES(1)=0 CALL CONCAT('div',BNS,ES,131) CALL CONCAT(ES,AFS,ES,131) CALL CONCAT(ES,',',ES,131) CALL CONCAT(ES,AOS,ES,131) GO TO 5365 5430 IF(ISCOMP(ATHS,'L.SHIFT') .NE. 0) GO TO 5480 ES(1)=0 CALL CONCAT('.rept ',AFS,ES,131) CALL OUTPUT ES(1)=0 CALL CONCAT('asl',BNS,ES,131) CALL CONCAT(ES,AOS,ES,131) 5435 CALL OUTPUT CALL SCOPY('.endr ',ES) GO TO 5365 5480 IF(ISCOMP(ATHS,'R.SHIFT') .NE. 0) GO TO 5510 ES(1)=0 CALL CONCAT('.rept ',AFS,ES,131) CALL OUTPUT ES(1)=0 CALL CONCAT('asr',BNS,ES,131) CALL CONCAT(ES,' ',ES,131) CALL CONCAT(ES,AOS,ES,131) GO TO 5435 5510 IF(ISCOMP(ATHS,'L.ROTATE') .NE. 0) GO TO 5540 ES(1)=0 CALL CONCAT('.rept ',AFS,ES,131) CALL OUTPUT CALL CONCAT('rol',BNS,ES,131) CALL CONCAT(ES,' ',ES,131) CALL CONCAT(ES,AOS,ES,131) GO TO 5435 5540 IF(ISCOMP(ATHS,'R.ROTATE') .NE. 0) GO TO 5570 ES(1)=0 CALL CONCAT('.rept ',AFS,ES,131) CALL OUTPUT ES(1)=0 CALL CONCAT('ror',BNS,ES,131) CALL CONCAT(ES,' ',ES,131) CALL CONCAT(ES,AOS,ES,131) GO TO 5435 5570 IF(ISCOMP(ATHS,'SHIFT') .NE. 0) GO TO 5600 ES(1)=0 CALL CONCAT('.rept ',AFS,ES,131) CALL OUTPUT ES(1)=0 CALL CONCAT('ash',BNS,ES,131) CALL CONCAT(ES,' ',ES,131) CALL CONCAT(ES,AOS,ES,131) GO TO 5435 5600 IF(ISCOMP(ATHS,'C.SHIFT') .NE. 0) GO TO 5630 ES(1)=0 CALL CONCAT('.rept ',AFS,ES,131) CALL OUTPUT ES(1)=0 CALL CONCAT('ashc',BNS,ES,131) CALL CONCAT(ES,' ',ES,131) CALL CONCAT(ES,AOS,ES,131) GO TO 5435 5630 IF(ISCOMP(ATHS,'XOR') .NE. 0) GO TO 5660 ES(1)=0 CALL CONCAT('xor',BNS,ES,131) 5650 CALL CONCAT(ES,' ',ES,131) CALL CONCAT(ES,AFS,ES,131) CALL CONCAT(ES,',',ES,131) CALL CONCAT(ES,AOS,ES,131) GO TO 5365 5660 IF((ISCOMP(ATHS,'NAND').NE.0).AND.(ISCOMP(ATHS,'OFF.BY').NE.0) 1.AND. (ISCOMP(ATHS,'CLEARED.BY') .NE. 0)) GO TO 5690 ES(1)=0 CALL CONCAT('bic',BNS,ES,131) GO TO 5650 5690 IF((ISCOMP(ATHS,'SET.BY') .NE. 0) .AND. (ISCOMP(ATHS,'ON. +BY') .NE. 0) .AND.(ISCOMP(ATHS,'OR') .NE. 0)) GO TO 5720 ES(1)=0 CALL CONCAT('bis',BNS,ES,131) GO TO 5650 5720 ES(1)=0 CALL CONCAT('.Error--illegal operator(',ATHS,ES,131) CALL CONCAT(ES,') in LET(B) statement',ES,131) GO TO 5365 5900 ES(1)=0 CALL CONCAT('.Error illegal assignment operator(',ATS,ES,131) CALL CONCAT(ES,') in LET(B) ',ES,131) CALL OUTPUT RETURN END