SUBROUTINE INIT 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,TP(12) 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 LOGICAL*1 TIM(9),GARBAG(34),CS(2),DAT(9) INTEGER *4 UOS CALL SCOPY('|!#$%&()*=`~{}+<>?,/;][^@-:\_',GARBAG) GARBAG(31)=1H' GARBAG(32)=1H" GARBAG(33)=2H.. FREQ(17)=FREQ(17)+1 CALL TIME(TIM) CALL DATE(DAT) ES(1)=0 TYPE 14000,DAT,TIM 5 TYPE 6 6 FORMAT('$','Input file name > ') CALL GETSTR(7,FS,11) 11 IF(LEN(FS) .NE. 0) GO TO 8 TYPE *,' ** Supermac V1.2 **' GO TO 5 8 DO 2 K=1,LEN(FS) ! LET'S SEARCH FOR BAD INPUT SPECS CALL SEG(FS,CS,K,K) IF(IVERIF(CS,GARBAG) .EQ. 0) GO TO 12000 ! BAD INPUT 2 CONTINUE PPER=INDEX(FS,'/') IF(PPER .EQ. 0) GO TO 12 CALL SEG(FS,ONS,PPER,LEN(FS)) CALL SEG(FS,FS,1,PPER-1) GO TO 11 12 PPER=INDEX(FS,'.') IF(PPER .NE. 0) GO TO 14 CALL CONCAT(FS,'.SMA',FOS,11) CALL CONCAT(FS,'.MAC',OFS,14) RETURN 14 CALL SEG(FS,TP,PPER,LEN(FS)) IF(.NOT.(ISCOMP(TP,'.MAC') .EQ. 0)) GO TO 20 CALL STRPAD(FS,12) TYPE 17,(FS(I),I=1,12) 17 FORMAT('0',2X,'This filename has an illegal file extension ',12a1) GO TO 5 20 CALL SCOPY(FS,FOS,11,ERR) DD IF(ERR) CALL CONCAT(ES,';COMPILER STRING OFLO #22',ES,131) LOGICAL ERR CALL SEG(FS,TP,1,INDEX(FS,'.')) CALL CONCAT(TP,'MAC',OFS,14) RETURN 12000 TYPE *,'Illegal File Attribute or Extension -- Retype the line' GO TO 5 14000 FORMAT(2X,'****** Supermac Compiler Version 1.2 ****** ',2(9A1,3X),/) END