C**************************************************************************** C C C MAIN PROGRAM C BYTE IPAL(4),REST(73),PATNUM(80),TITLE(80),COMP(80), C ISYM(8,20),IBUF(8,20) BYTE E,O,T,P,B,H,S,L,N,Q,U,F,C,R,A, C BB,CC,DD,EE,FF,II,NN,OO,PP,RR,SS,TT,UU, C IPAGE,FNAME(11),MYLINE(80), C INOAI,IOT,INOO,CR,LF,IOP,CLRS LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR, C LFIX,LFIRST,LMATCH,LFUSES(32,64),LPHASE(20),LBUF(20), C LPROD(80),LSAME,LACT,LOPERR,LINP,LPRD,LHEAD COMMON LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR COMMON /PGE/ IPAGE(80,100) COMMON /FTEST/ IFUNCT,IDESC,IEND DATA E/'E'/,O/'O'/,T/'T'/,P/'P'/,B/'B'/,H/'H'/,S/'S'/,L/'L'/, C N/'N'/,Q/'Q'/,U/'U'/,F/'F'/,C/'C'/,R/'R'/,A/'A'/ DATA BB/'B'/,CC/'C'/,DD/'D'/,EE/'E'/,FF/'F'/,II/'I'/,NN/'N'/, C OO/'O'/,PP/'P'/,RR/'R'/,SS/'S'/,TT/'T'/,UU/'U'/ DATA CR/X'0D'/,LF/X'0A'/,CLRS/X'0C'/ 999 IFUNCT=0 IDESC=0 LSAME=.FALSE. LACT=.FALSE. LOPERR=.FALSE. LINP=.FALSE. LPRD=.FALSE. LHEAD=.FALSE. C WRITE(1,3)CLRS 3 FORMAT(' ',A1,' PAL ASSEMBLER VERSION 3.1 ',/////) 530 CALL GFNAME(FNAME,INUNIT,.TRUE.) CALL OPEN(6,FNAME,INUNIT) READ(6,10,END=500) IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP 10 FORMAT(4A1,A1,A1,A1,73A1,/,80A1,/,80A1,/,80A1) GOTO 510 500 WRITE(1,520) ENDFILE 6 520 FORMAT(' FILE DOESN''T EXIST, REENTER',/) GOTO 530 C 510 WRITE(1,511) IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP 511 FORMAT(' '4A1,A1,A1,A1,73A1,/,' ',80A1,/, C ' ',80A1,/,' ',80A1) DO 15 J=1,100 READ(6,11,END=16) MYLINE 11 FORMAT(80A1) WRITE(1,561)MYLINE 561 FORMAT(' ',80A1) DO 560 I = 1,80 IPAGE(I,J) = ' ' 560 IF(.NOT.((MYLINE(I).EQ.CR).OR.(MYLINE(I).EQ.LF))) C IPAGE(I,J) = MYLINE(I) IF( IFUNCT.EQ.0 .AND.IPAGE(1,J).EQ.FF.AND. C IPAGE(3,J).EQ.NN.AND.IPAGE(5,J).EQ.TT.AND. C IPAGE(7,J).EQ.OO.AND.IPAGE(10,J) .EQ.TT ) IFUNCT=J IF( IDESC.EQ.0 .AND.IPAGE(1,J).EQ.DD.AND. C IPAGE(3,J).EQ.SS.AND.IPAGE(5,J).EQ.RR.AND. C IPAGE(7,J).EQ.PP.AND.IPAGE(10,J) .EQ.OO ) IDESC=J 15 CONTINUE 16 IEND=J-1 CALL INITLZ(INOAI,IOT,INOO,ITYPE,LFUSES,IC,IL,IBLOW,LFIX) ILE=IL+1 IF(ITYPE.NE.0) GO TO 17 WRITE(1,18) IPAL,INOAI,IOT,INOO 18 FORMAT(/,' PAL PART TYPE ',4A1,A1,A1,A1,' IS INCORRECT') STOP ERROR 17 DO 20 J=1,20 20 CALL GETSYM(LPHASE,ISYM,J,IC,IL,LFIX) IF(.NOT.(LEQUAL.OR.LLEFT.OR.LAND.OR.LOR.OR.LRIGHT)) GO TO 24 WRITE(1,23) 23 FORMAT(/,' LESS THAN 20 PIN NAMES IN PIN LIST') STOP ERROR 24 ILE=IL 25 CALL GETSYM(LBUF,IBUF,1,IC,IL,LFIX) 28 IF(.NOT.LEQUAL) GO TO 25 COUNT=0 ILL=IL CALL MATCH(IMATCH,IBUF,ISYM) IF( IMATCH.EQ.0 ) GO TO 100 IPRD=IMATCH LSAME = ( ( LPHASE(IMATCH)).AND.( LBUF(1)).OR. C (.NOT.LPHASE(IMATCH)).AND.(.NOT.LBUF(1)) ) IF( IOT.EQ.H.AND.(.NOT.LSAME) ) LACT=.TRUE. IF( (.NOT.(IOT.EQ.H.OR.IOT.EQ.C)).AND.(LSAME) ) LACT=.TRUE. IF( (ITYPE.EQ.1.OR.ITYPE.EQ.5.OR.ITYPE.EQ.6).AND.IOT.NE.A. C AND.(IMATCH.LT.12.OR.IMATCH.GT.19) ) LOPERR=.TRUE. IF( ITYPE.EQ.2.AND.(IMATCH.LT.13.OR.IMATCH.GT.18) ) C LOPERR=.TRUE. IF( ITYPE.EQ.3.AND.(IMATCH.LT.14.OR.IMATCH.GT.17) ) C LOPERR=.TRUE. IF( ITYPE.EQ.4.AND.(IMATCH.LT.15.OR.IMATCH.GT.16) ) C LOPERR=.TRUE. IF( (LACT).OR.(LOPERR) ) GO TO 100 I88PRO=(19-IMATCH)*8 + 1 IF(IOT.EQ.C) I88PRO=25 IC=0 30 CALL INCR(IC,IL,LFIX) IF( .NOT.(LEQUAL.OR.LLEFT) ) GO TO 30 LPROD(I88PRO)=.TRUE. IF(.NOT.LLEFT) CALL SLIP(LFUSES,I88PRO,INOAI,IOT,INOO,IBLOW) DO 70 I8PRO=1,16 COUNT = COUNT + 1 IPROD = I88PRO + I8PRO - 1 LPROD(IPROD)=.TRUE. LFIRST=.TRUE. 50 ILL=IL CALL GETSYM(LBUF,IBUF,1,IC,IL,LFIX) IF( (ITYPE.EQ.1.OR.ITYPE.EQ.2.AND.IPRD.GT.13 C .AND.IPRD.LT.18).AND.COUNT.GT.2 ) LPRD=.TRUE. IF( (ITYPE.EQ.3.OR.ITYPE.EQ.2.AND.(IPRD.EQ.13.OR. C IPRD.EQ.18)).AND.COUNT.GT.4 ) LPRD=.TRUE. IF( IOT.NE.A.AND.IOT.NE.C.AND.COUNT.GT.8 ) LPRD=.TRUE. IF( .NOT.LPRD ) GO TO 69 IF(IL.NE.IFUNCT.AND.IL.NE.IDESC) ILL=IL IPROD = IPROD - 1 GO TO 118 69 IF(LFIX) GO TO 59 CALL MATCH(IMATCH,IBUF,ISYM) IF( ITYPE.EQ.1.AND.IMATCH.GT.11 ) LINP=.TRUE. IF( ITYPE.EQ.2.AND.(IMATCH.GT.12.AND.IMATCH.LT.19) ) C LINP=.TRUE. IF( ITYPE.EQ.3.AND.(IMATCH.GT.13.AND.IMATCH.LT.18) ) C LINP=.TRUE. ILL=IL IF(LINP) GO TO 100 IF( IMATCH.EQ.0 ) GO TO 100 IF( IMATCH.EQ.10.OR.IMATCH.EQ.99 ) GO TO 64 IF(.NOT.LFIRST) GO TO 58 LFIRST=.FALSE. DO 56 I=1,32 IBLOW = IBLOW + 1 56 LFUSES(I,IPROD)=.TRUE. 58 CALL IXLATE(IINPUT,IMATCH,LPHASE,LBUF,ITYPE) IF(IINPUT.LE.0) GO TO 60 IBLOW = IBLOW - 1 LFUSES(IINPUT,IPROD)=.FALSE. CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.FALSE.,ITYPE, C LPROD,IOP,IBLOW) GO TO 60 59 CALL FIXSYM(LBUF,IBUF,IC,IL,LFIRST,LFUSES,IBLOW, C IPROD,LFIX) 60 IF(LAND) GO TO 50 64 IF(.NOT.LRIGHT) GO TO 68 66 CALL INCR(IC,IL,LFIX) IF(.NOT.LEQUAL) GO TO 66 68 IF( .NOT.(LOR.OR.LEQUAL) ) GO TO 74 70 CONTINUE 74 ILL=IL CALL GETSYM(LBUF,IBUF,1,IC,IL,LFIX) IF(LLEFT.OR.LEQUAL) GO TO 28 100 IF( ILL.EQ.IFUNCT.OR.ILL.EQ.IDESC ) GO TO 102 ILERR=ILL+4 WRITE(1,101) (IBUF(I,1),I=1,8),ILERR,(IPAGE(I,ILL),I=1,79) 101 FORMAT(' ERROR SYMBOL = ',8A1,' IN LINE NUMBER ',I3, C /,' ',80A1) IF( (LACT).AND.( LSAME).AND.(.NOT.LOPERR) ) C WRITE(1,103) IPAL,INOAI,IOT,INOO 103 FORMAT(' OUTPUT MUST BE INVERTED SINCE ',4A1,A1,A1,A1, C ' IS AN ACTIVE LOW DEVICE') IF( (LACT).AND.(.NOT.LSAME).AND.(.NOT.LOPERR) ) C WRITE(1,109) IPAL,INOAI,IOT,INOO 109 FORMAT(' OUTPUT CANNOT BE INVERTED SINCE ',4A1,A1,A1,A1, C ' IS AN ACTIVE HIGH DEVICE') IF( (LOPERR).AND.IMATCH.NE.0 ) C WRITE(1,105) IMATCH,IPAL,INOAI,IOT,INOO 105 FORMAT(' THIS PIN NUMBER ',I2,' IS AN INVALID OUTPUT PIN', C ' FOR ',4A1,A1,A1,A1) IF(LINP) WRITE(1,115) IMATCH,IPAL,INOAI,IOT,INOO 115 FORMAT(' THIS PIN NUMBER ',I2,' IS AN INVALID INPUT PIN', C ' FOR ',4A1,A1,A1,A1) 118 ILERR=ILL+4 IF(LPRD) WRITE(1,119) C (ISYM(I,IPRD),I=1,8),IPRD,ILERR,(IPAGE(I,ILL),I=1,79) 119 FORMAT(' OUTPUT PIN NAME = ',8A1,' OUTPUT PIN NUMBER = ',I2, C ' MINTERM IN LINE NUMBER ',I3,/,' ',80A1) IF( LPRD.AND.COUNT.LT.8 ) C WRITE(1,116) IPROD,IPAL,INOAI,IOT,INOO 116 FORMAT(' THIS PRODUCT LINE NUMBER ',I2,' IS NOT VALID', C ' FOR ',4A1,A1,A1,A1) IF( LPRD.AND.COUNT.GT.8 ) C WRITE(1,117) IPAL,INOAI,IOT,INOO 117 FORMAT(' MAXIMUM OF 8 PRODUCTS LINES ARE VALID FOR ',4A1,A1,A1,A1, C ' TOO MANY MINTERMS ARE SPECIFIED IN THIS EQUATION') STOP ERROR 102 IF(ITYPE.LE.4) CALL TWEEK(ITYPE,IOT,LFUSES) ENDFILE 6 108 WRITE(1,106) 106 FORMAT(' OPERATION CODES:') WRITE(1,107) 107 FORMAT(/,' E=ECHO O=PINOUT P=PLOT B=BRIEF ', C /,' H=HEX L=BHLF N=BNPF Q=QUIT S=SIMULATE') WRITE(1,110) 110 FORMAT(' ENTER OPERATION CODE:') READ(1,120) IOP 120 FORMAT(A1) IF(IOP.EQ.E) CALL ECHO(IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE, C COMP) IF(IOP.EQ.O) CALL PINOUT(IPAL,INOAI,IOT,INOO,TITLE) IF(IOP.EQ.P) CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.TRUE.,ITYPE, C LPROD,IOP,IBLOW) IF(IOP.EQ.B) CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.TRUE.,ITYPE, C LPROD,IOP,IBLOW) IF(IOP.EQ.H) CALL HEX(LFUSES) IF(IOP.EQ.L) CALL BINR(LFUSES,H,L) IF(IOP.EQ.N) CALL BINR(LFUSES,P,N) C IF(IOP.EQ.R) GOTO 999 IF(IOP.EQ.S) CALL TEST(LPHASE,LBUF,TITLE,IC,IL,ILE,ISYM,IBUF, C ITYPE,INOO,LFIX) IF(IOP.NE.Q) GO TO 108 STOP END C C************************************************************************ C SUBROUTINE INITLZ(INOAI,IOT,INOO,ITYPE,LFUSES,IC,IL,IBLOW,LFIX) BYTE INOAI,IOT,INOO LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR, C LFIX,LFUSES(32,64) BYTE IPAGE,H,L,C,R,X,A,I0,I2,I4,I6,I8,INOAI,IOT,INOO COMMON LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR COMMON /PGE/ IPAGE(80,100) DATA H/'H'/,L/'L'/,C/'C'/,R/'R'/,X/'X'/,A/'A'/ C I0/'0'/,I2/'2'/,I4/'4'/,I6/'6'/,I8/'8'/ DO 20 J=1,64 DO 20 I=1,32 20 LFUSES(I,J)=.FALSE. IBLOW=0 IC=0 IL=1 ITYPE=0 IF( INOAI.EQ.I0 ) ITYPE=1 IF( INOAI.EQ.I2 ) ITYPE=2 IF( INOAI.EQ.I4 ) ITYPE=3 IF( (INOAI.EQ.I6) ) ITYPE=4 IF( (INOAI.EQ.I6).AND.(INOO.EQ.I8) ) ITYPE=5 IF( (IOT.EQ.R).OR.(IOT.EQ.X).OR.(IOT.EQ.A) ) ITYPE=6 IF( .NOT.(IOT.EQ.H.OR.IOT.EQ.L.OR.IOT.EQ.C C .OR.IOT.EQ.R.OR.IOT.EQ.X.OR.IOT.EQ.A) ) ITYPE=0 CALL INCR(IC,IL,LFIX) RETURN END C C************************************************************************* C SUBROUTINE INCR(IC,IL,LFIX) LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR, C LFIX,LX1 BYTE IPAGE,IBLANK,ILEFT,IAND,IOR,COMENT,ISLASH,IEQUAL, C IRIGHT,ICOLON COMMON LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR COMMON /PGE/ IPAGE(80,100) DATA IBLANK/' '/,ILEFT/'('/,IAND/'*'/,IOR/'+'/,COMENT/';'/, C ISLASH/'/'/,IEQUAL/'='/,IRIGHT/')'/,ICOLON/':'/ LBLANK=.FALSE. LXOR=.FALSE. LXNOR=.FALSE. LX1=.FALSE. LRIGHT=.FALSE. 10 IC=IC+1 IF( IC.LE.79.AND.IPAGE(IC,IL).NE.COMENT ) GO TO 30 IL=IL+1 20 IC=0 GO TO 10 30 IF( IPAGE(IC,IL).EQ.ICOLON.AND.(LFIX) ) RETURN IF( IPAGE(IC,IL).NE.IBLANK ) GO TO 31 LBLANK=.TRUE. GO TO 10 31 IF( IPAGE(IC,IL).NE.ICOLON ) GO TO 32 IF( (LXOR).OR.(LXNOR) ) GO TO 33 LX1=.TRUE. GO TO 10 33 IF(LXOR) LOR=.TRUE. IF(LXNOR) LAND=.TRUE. RETURN 32 IF( .NOT.(LX1.AND.(IPAGE(IC,IL).EQ.IOR.OR.IPAGE(IC,IL).EQ.IAND)) ) C GO TO 34 IF( IPAGE(IC,IL).EQ.IOR ) LXOR=.TRUE. IF( IPAGE(IC,IL).EQ.IAND ) LXNOR=.TRUE. GO TO 10 34 LLEFT =( IPAGE(IC,IL).EQ.ILEFT ) LAND =( IPAGE(IC,IL).EQ.IAND ) LOR =( IPAGE(IC,IL).EQ. IOR ) LSLASH=( IPAGE(IC,IL).EQ.ISLASH ) LEQUAL=( IPAGE(IC,IL).EQ.IEQUAL ) LRIGHT=( IPAGE(IC,IL).EQ.IRIGHT ) RETURN END C C************************************************************************ C SUBROUTINE GETSYM(LPHASE,ISYM,J,IC,IL,LFIX) BYTE ISYM(8,20) LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR, C LFIX,LPHASE(20) BYTE IPAGE,IBLANK COMMON LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR COMMON /PGE/ IPAGE(80,100) DATA IBLANK/' '/ LFIX=.FALSE. IF( .NOT.(LLEFT.OR.LAND.OR.LOR.OR.LEQUAL.OR.LRIGHT) ) GO TO 10 CALL INCR(IC,IL,LFIX) IF(LLEFT) GO TO 60 10 LPHASE(J)=( .NOT.LSLASH ) IF(LPHASE(J)) GO TO 15 CALL INCR(IC,IL,LFIX) 15 DO 20 I=1,8 20 ISYM(I,J)=IBLANK 25 DO 30 I=1,7 30 ISYM(I,J)=ISYM(I+1,J) ISYM(8,J)=IPAGE(IC,IL) CALL INCR(IC,IL,LFIX) IF( LLEFT.OR.LBLANK.OR.LAND.OR.LOR.OR.LRIGHT.OR.LEQUAL ) RETURN GO TO 25 60 LFIX=.TRUE. RETURN END C C*************************************************************************** C SUBROUTINE MATCH(IMATCH,IBUF,ISYM) BYTE IBUF(8,20),ISYM(8,20) LOGICAL LMATCH BYTE C,A,R,Y DATA C/'C'/,A/'A'/,R/'R'/,Y/'Y'/ IMATCH=0 DO 20 J=1,20 LMATCH=.TRUE. DO 10 I=1,8 10 LMATCH=LMATCH.AND.(IBUF(I,1).EQ.ISYM(I,J)) IF(LMATCH) IMATCH=J 20 CONTINUE IF( IBUF(3,1).EQ.C.AND.IBUF(4,1).EQ.A.AND.IBUF(5,1).EQ.R.AND. C IBUF(6,1).EQ.R.AND.IBUF(7,1).EQ.Y ) IMATCH=99 RETURN END C C********************************************************************** C SUBROUTINE IXLATE(IINPUT,IMATCH,LPHASE,LBUF,ITYPE) BYTE ITABLE(20,6) LOGICAL LPHASE(20),LBUF(20) DATA ITABLE/ C 3, 1, 5, 9,13,17,21,25,29,-10,31,-1,-1,-1,-1,-1,-1,-1,-1,-20, C 3, 1, 5, 9,13,17,21,25,29,-10,31,27,-1,-1,-1,-1,-1,-1, 7,-20, C 3, 1, 5, 9,13,17,21,25,29,-10,31,27,23,-1,-1,-1,-1,11, 7,-20, C 3, 1, 5, 9,13,17,21,25,29,-10,31,27,23,19,-1,-1,15,11, 7,-20, C 3, 1, 5, 9,13,17,21,25,29,-10,31,-1,27,23,19,15,11, 7,-1,-20, C -1, 1, 5, 9,13,17,21,25,29,-10,-1,31,27,23,19,15,11, 7, 3,-20/ IINPUT=0 IBUBL=0 IF((( LPHASE(IMATCH)).AND.(.NOT.LBUF(1))).OR. C ((.NOT.LPHASE(IMATCH)).AND.( LBUF(1)))) IBUBL=1 IF( ITABLE(IMATCH,ITYPE).GT.0 ) IINPUT=ITABLE(IMATCH,ITYPE)+IBUBL RETURN END C C************************************************************************ C SUBROUTINE PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,LDUMP,ITYPE, C LPROD,IOP,IBLOW) BYTE IBUF(8,20),IOUT(64),TITLE(80) LOGICAL LBUF(20),LFUSES(32,64),LDUMP,LPROD(80) BYTE ISAVE(64,32),IAND,IOR,ISLASH, C IDASH,X,IBLANK,P,B,HIFANT,IOP,CLRS DATA ISAVE/2048*' '/,IAND/'*'/,IOR/'+'/,ISLASH/'/'/, C IDASH/'-'/,X/'X'/,IBLANK/' '/,P/'P'/,B/'B'/, C HIFANT/'O'/,CLRS/X'0C'/ IF(.NOT.LDUMP) GO TO 4 4 IF(LDUMP) GO TO 60 IF(ISAVE(IPROD,1).NE.IBLANK) RETURN IF( LBUF(1) ) GO TO 5 DO 30 J=1,31 30 ISAVE(IPROD,J)=ISAVE(IPROD,J+1) ISAVE(IPROD,32)=ISLASH 5 DO 20 I=1,8 IF( ISAVE(IPROD,1).NE.IBLANK ) RETURN IF( IBUF(I,1).EQ.IBLANK ) GO TO 20 DO 10 J=1,31 10 ISAVE(IPROD,J)=ISAVE(IPROD,J+1) ISAVE(IPROD,32)=IBUF(I,1) 20 CONTINUE IF(ISAVE(IPROD,1).NE.IBLANK) RETURN 40 DO 50 J=1,31 50 ISAVE(IPROD,J)=ISAVE(IPROD,J+1) ISAVE(IPROD,32)=IAND RETURN 60 WRITE(1,62) CLRS,TITLE 62 FORMAT(' ',A1,80A1,//, C ' 11 1111 1111 2222 2222 2233',/, C ' 0123 4567 8901 2345 6789 0123 4567 8901',/) DO 100 I88PRO=1,57,8 DO 94 I8PRO=1,8 IPROD=I88PRO+I8PRO-1 ISAVE(IPROD,32)=IBLANK DO 70 I=1,32 IF( ISAVE(IPROD,1).NE.IBLANK ) GO TO 70 DO 65 J=1,31 ISAVE(IPROD,J)=ISAVE(IPROD,J+1) 65 CONTINUE ISAVE(IPROD,32)=IBLANK 70 CONTINUE DO 80 I=1,32 IOUT(I)=X IF( LFUSES(I,IPROD) ) IOUT(I)=IDASH IOUT(I+32)=ISAVE(IPROD,I) 80 CONTINUE IF(ITYPE.LE.4) CALL FANTOM(ITYPE,IOUT,IPROD,I8PRO) IPROD=IPROD-1 DO 85 J=1,32 IF( IOP.EQ.B.AND.IOUT(J).EQ.HIFANT ) IOUT(J)=IBLANK 85 CONTINUE IF( (IOP.EQ.P).OR.(IOP.EQ.B.AND.(LPROD(IPROD+1))) ) C WRITE(1,90) IPROD,IOUT 90 FORMAT(' ',I2,8(' ',4A1),' ',32A1) 94 CONTINUE WRITE(1,96) 96 FORMAT(1X) 100 CONTINUE WRITE(1,110) 110 FORMAT(/, C' LEGEND: X : FUSE NOT BLOWN (L,N,0) - : FUSE BLOWN (H,P,1)') IF( IOP.EQ.P.AND.ITYPE.LE.4 ) WRITE(1,111) 111 FORMAT( C' 0 : PHANTOM FUSE (L,N,0) O : PHANTOM FUSE (H,P,1)') WRITE(1,112) IBLOW 112 FORMAT(/,' NUMBER OF FUSES BLOWN = ',I4) WRITE(1,113) 113 FORMAT(////) RETURN END C C************************************************************************* C SUBROUTINE TWEEK(ITYPE,IOT,LFUSES) BYTE IOT LOGICAL LFUSES(32,64) BYTE L,C DATA L/'L'/,C/'C'/ IF(ITYPE.GE.4) GO TO 20 DO 10 IPROD=1,64 LFUSES(15,IPROD)=.TRUE. LFUSES(16,IPROD)=.TRUE. LFUSES(19,IPROD)=.TRUE. LFUSES(20,IPROD)=.TRUE. IF(ITYPE.GE.3) GO TO 10 LFUSES(11,IPROD)=.TRUE. LFUSES(12,IPROD)=.TRUE. LFUSES(23,IPROD)=.TRUE. LFUSES(24,IPROD)=.TRUE. IF(ITYPE.GE.2) GO TO 10 LFUSES( 7,IPROD)=.TRUE. LFUSES( 8,IPROD)=.TRUE. LFUSES(27,IPROD)=.TRUE. LFUSES(28,IPROD)=.TRUE. 10 CONTINUE DO 18 IINPUT=7,28 DO 12 IPROD=1,57,8 LFUSES(IINPUT,IPROD+4)=.FALSE. LFUSES(IINPUT,IPROD+5)=.FALSE. LFUSES(IINPUT,IPROD+6)=.FALSE. 12 LFUSES(IINPUT,IPROD+7)=.FALSE. IF(ITYPE.GE.3) GO TO 18 DO 14 IPROD=17,41,8 LFUSES(IINPUT,IPROD+2)=.FALSE. 14 LFUSES(IINPUT,IPROD+3)=.FALSE. IF(ITYPE.GE.2) GO TO 18 DO 16 IPROD=1,57,8 LFUSES(IINPUT,IPROD+2)=.FALSE. 16 LFUSES(IINPUT,IPROD+3)=.FALSE. 18 CONTINUE 20 IF( (ITYPE.EQ.1) .OR. ((ITYPE.EQ.4).AND.(IOT.EQ.L)) ) RETURN DO 99 IINPUT=1,32 DO 30 IPROD=1,8 LFUSES(IINPUT,IPROD+ 0)= (IOT.NE.L) 30 IF(IOT.NE.C) LFUSES(IINPUT,IPROD+56)= (IOT.NE.L) IF(ITYPE.LE.2) GO TO 99 DO 40 IPROD=1,8 LFUSES(IINPUT,IPROD+ 8)= (IOT.NE.L) 40 IF(IOT.NE.C) LFUSES(IINPUT,IPROD+48)= (IOT.NE.L) IF(ITYPE.LE.3) GO TO 99 DO 50 IPROD=1,8 LFUSES(IINPUT,IPROD+16)= (IOT.NE.L) 50 IF(IOT.NE.C) LFUSES(IINPUT,IPROD+40)= (IOT.NE.L) 99 CONTINUE RETURN END C C************************************************************************ C SUBROUTINE SLIP(LFUSES,I88PRO,INOAI,IOT,INOO,IBLOW) LOGICAL LFUSES(32,64) BYTE R,I1,I2,I4,I6,I8,IOT,INOO,INOAI DATA R/'R'/,I1/'1'/,I2/'2'/,I4/'4'/,I6/'6'/,I8/'8'/ IF( (INOAI.NE.I6) .OR. (INOO.EQ.I1) .OR. (INOO.EQ.I2) .OR. C ( (IOT.EQ.R).AND.(INOO.EQ.I8) ) .OR. C ( (I88PRO.GE. 9).AND.(I88PRO.LE.49).AND.(INOO.EQ.I6) ) .OR. C ( (I88PRO.GE.17).AND.(I88PRO.LE.41).AND.(INOO.EQ.I4)) ) RETURN DO 10 I=1,32 IBLOW = IBLOW + 1 10 LFUSES(I,I88PRO) = .TRUE. I88PRO = I88PRO + 1 RETURN END C C************************************************************************* C SUBROUTINE FANTOM(ITYPE,IOUT,IPROD,I8PRO) BYTE IOUT(64) BYTE X,IDASH,LOFANT,HIFANT DATA X/'X'/,IDASH/'-'/,LOFANT/'0'/,HIFANT/'O'/ DO 10 I=1,32 IF( IOUT(I).EQ.IDASH ) IOUT(I)=HIFANT IF( IOUT(I).EQ.X ) IOUT(I)=LOFANT 10 CONTINUE IF((ITYPE.EQ.4).AND.((IPROD.LE.24).OR.(IPROD.GE.41))) RETURN IF((ITYPE.EQ.3).AND.((IPROD.LE.16).OR.(IPROD.GE.45))) RETURN IF((ITYPE.EQ.2).AND.((IPROD.LE. 8).OR.(IPROD.GE.53))) RETURN IF((ITYPE.LE.3).AND.(I8PRO.GE.5)) RETURN IF((ITYPE.LE.2).AND.(IPROD.GE.19).AND.(IPROD.LE.48).AND. C (I8PRO.GE.3)) RETURN IF((ITYPE.EQ.1).AND.(I8PRO.GE.3)) RETURN DO 50 I=1,32 IF(((I.EQ.15).OR.(I.EQ.16).OR.(I.EQ.19).OR.(I.EQ.20)).AND. C (ITYPE.LE.3)) GO TO 50 IF(((I.EQ.11).OR.(I.EQ.12).OR.(I.EQ.23).OR.(I.EQ.24)).AND. C (ITYPE.LE.2)) GO TO 50 IF(((I.EQ. 7).OR.(I.EQ. 8).OR.(I.EQ.27).OR.(I.EQ.28)).AND. C (ITYPE.LE.1)) GO TO 50 IF( IOUT(I).EQ.HIFANT ) IOUT(I)=IDASH IF( IOUT(I).EQ.LOFANT ) IOUT(I)=X 50 CONTINUE RETURN END C C**************************************************************************** C ***************************************************************** SUBROUTINE DATAIO (TEXT,NUMBER) LOGICAL TEXT(1) INTEGER NUMBER EXTERNAL PUNCH DO 10 I= 1, NUMBER 10 CALL PUNCH(TEXT(I)) RETURN END C *********************************************************** C *********************************************************** C *********************************************************** LOGICAL FUNCTION IHEXA(I) LOGICAL STRNG(16) DATA STRNG/'0','1','2','3','4','5','6','7','8','9', 1 'A','B','C','D','E','F'/ M=MOD(I,16)+1 IHEXA=STRNG(M) RETURN END C ********** SUBROUTINE HEX(LFUSES) LOGICAL LFUSES(32,64) LOGICAL ITEMP(64),IHEXA LOGICAL T(128) LOGICAL STX,ETX,NULL(50),DC1,READER EXTERNAL READER DATA STX/X'02'/,ETX/X'03'/,NULL/50*X'00'/,DC1/X'11'/ WRITE(1,81) 81 FORMAT(' DATA I/O SETUP:'/' TYPE ''SELECT 50,ENTER''') WRITE(1,82) 82 FORMAT(' TYPE ''SELECT D2,ENTER''') WRITE(1,83) 83 FORMAT(' THEN PRESS ''START'' BUTTON ') 87 IF(READER(0).XOR.DC1) GOTO 87 WRITE(1,88) 88 FORMAT(' STARTING TRANSMISSION') ENCODE(T,70)STX CALL DATAIO(T,1) DO 40 I=1,33,32 INC=I-1 DO 40 IPROD=1,7,2 DO 20 J=1,2 DO 20 IINPUT=1,32 IHEX=0 M=IPROD+INC+J-1 IF(LFUSES(IINPUT,M+ 0)) IHEX=IHEX+1 IF(LFUSES(IINPUT,M+ 8)) IHEX=IHEX+2 IF(LFUSES(IINPUT,M+16)) IHEX=IHEX+4 IF(LFUSES(IINPUT,M+24)) IHEX=IHEX+8 M=IINPUT+32*(J-1) 20 ITEMP(M)=IHEXA(IHEX) ENCODE(T,60)ITEMP 40 CALL DATAIO(T,128) ENCODE(T,80)ETX,NULL CALL DATAIO(T,51) 60 FORMAT(64(A1,' ')) 70 FORMAT(A1) 80 FORMAT(51A1) RETURN END C C************************************************************************* C SUBROUTINE ECHO(IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP) BYTE IPAL(4),REST(73),PATNUM(80),TITLE(80),COMP(79) BYTE IPAGE,INOAI,IOT,INOO,CLRS COMMON /PGE/ IPAGE(80,100) COMMON /FTEST/ IFUNCT,IDESC,IEND DATA CLRS/X'0C'/ WRITE(1,10)CLRS,IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP 10 FORMAT(' ',A1,4A1,A1,A1,A1,73A1,/,' ',80A1,/,' ',80A1,/,' ',80A1) DO 30 J=1,IEND WRITE(1,20) (IPAGE(I,J),I=1,80) 20 FORMAT(' ',80A1) 30 CONTINUE RETURN END C C****************************************************************************** C SUBROUTINE BINR(LFUSES,H,L) BYTE ITEMP(4,8),H,L,CLRS LOGICAL LFUSES(32,64) DATA CLRS/X'0C'/ WRITE(1,10)CLRS 10 FORMAT(' ',A1) DO 20 I=1,33,32 INC=I-1 DO 20 IPROD=1,8 DO 20 J=1,25,8 DO 15 K=1,8 IINPUT=J+K-1 ITEMP(1,K)=L ITEMP(2,K)=L ITEMP(3,K)=L ITEMP(4,K)=L MYINX = IPROD + INC IF(LFUSES(IINPUT,MYINX + 0)) ITEMP(4,K)=H IF(LFUSES(IINPUT,MYINX + 8)) ITEMP(3,K)=H IF(LFUSES(IINPUT,MYINX + 16)) ITEMP(2,K)=H IF(LFUSES(IINPUT,MYINX + 24)) ITEMP(1,K)=H 15 CONTINUE 20 WRITE(1,30) ITEMP 30 FORMAT(' ',8('B',4A1,'F ')) WRITE(1,10) RETURN END C C************************************************************************** C SUBROUTINE PINOUT(IPAL,INOAI,IOT,INOO,TITLE) BYTE IPAL(4),TITLE(80),PIN(8,20),IIN(7,2) BYTE IPAGE,IBLANK,ISTAR,INOAI,IOT,INOO,CLRS COMMON /PGE/ IPAGE(80,100) DATA IBLANK/' '/,ISTAR/'*'/,CLRS/X'0C'/ DO 10 J=1,20 DO 5 I=1,8 5 PIN(I,J)=IBLANK 10 CONTINUE 15 DO 25 J=1,2 DO 20 I=1,7 20 IIN(I,J)=IBLANK 25 CONTINUE IIN(2,1)=IPAL(1) IIN(4,1)=IPAL(2) IIN(6,1)=IPAL(3) IIN(1,2)=IPAL(4) IIN(3,2)=INOAI IIN(5,2)=IOT IIN(7,2)=INOO J=0 IL=0 30 IC=0 IL=IL+1 35 IC=IC+1 40 IF( IC.GT.80 ) GO TO 30 IF( IPAGE(IC,IL).EQ.IBLANK ) GO TO 35 J=J+1 IF(J.GT.20) GO TO 60 DO 55 I=1,8 PIN(I,J)=IPAGE(IC,IL) IC=IC+1 IF( IC.GT.80 ) GO TO 40 IF( IPAGE(IC,IL).EQ.IBLANK ) GO TO 40 55 CONTINUE 60 DO 75 J=1,10 II=0 65 II=II+1 IF(II.EQ.9) GO TO 75 IF( PIN(II,J).NE.IBLANK ) GO TO 65 I=9 70 I=I-1 II=II-1 PIN(I,J)=PIN(II,J) PIN(II,J)=IBLANK IF(II.NE.1) GO TO 70 75 CONTINUE WRITE(1,76)CLRS,TITLE 76 FORMAT(' ',A1,80A1) WRITE(1,78) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR, C ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR, C ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR, C ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR 78 FORMAT(/,' ',14X,14A1,3X,14A1, C /,' ',14X,A1,13X,A1,1X,A1,13X,A1) JJ=20 DO 88 J=1,10 WRITE(1,80) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR 80 FORMAT(' ',11X,4A1,29X,4A1) WRITE(1,81) (PIN(I,J),I=1,8),ISTAR,J,ISTAR, C (IIN(I,1),I=1,7),ISTAR,JJ,ISTAR,(PIN(I,JJ),I=1,8) 81 FORMAT(' ',8A1,3X,A1,I2,A1,11X,7A1,11X,A1,I2,A1,3X,8A1) WRITE(1,82) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR 82 FORMAT(' ',11X,4A1,29X,4A1) WRITE(1,84) ISTAR,(IIN(I,2),I=1,7),ISTAR 84 FORMAT(' ',14X,A1,11X,7A1,11X,A1) DO 86 II=1,2 DO 85 I=1,7 85 IIN(I,II)=IBLANK 86 CONTINUE JJ=JJ-1 88 CONTINUE WRITE(1,90) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR, C ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR, C ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR, C ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR 90 FORMAT(' ',14X,31A1) RETURN END C C***************************************************************************** C SUBROUTINE FIXSYM(LBUF,IBUF,IC,IL,LFIRST,LFUSES,IBLOW,IPROD,LFIX) LOGICAL LBUF(20),LFUSES(32,64),LFIRST,LMATCH,LFIX BYTE IBUF(8,20),FIXBUF(8) BYTE IPAGE,A,B,ISLASH,IOR,IBLANK,IRIGHT,IAND, C N,Q,N0,N1,N2,N3,ICOLON,TABLE(5,14) COMMON /PGE/ IPAGE(80,100) DATA A/'A'/,B/'B'/,ISLASH/'/'/,IOR/'+'/,IBLANK/' '/,IRIGHT/')'/, C IAND/'*'/,N/'N'/,Q/'Q'/,N0/'0'/,N1/'1'/,N2/'2'/,N3/'3'/, C ICOLON/':'/ DATA TABLE / ' ','A','+','/','B',' ',' ','A','+','B', C ' ',' ',' ',' ','A','/','A','+','/','B',' ',' ',' ','/','B', C 'A',':','+',':','B',' ','A','*','/','B',' ','/','A','+','B', C 'A',':','*',':','B',' ',' ',' ',' ','B',' ',' ','A','*','B', C ' ',' ',' ','/','A','/','A','*','/','B',' ','/','A','*','B'/ IINPUT=0 DO 20 I=1,8 IBUF(I,1)=IBLANK 20 FIXBUF(I)=IBLANK 21 CALL INCR(IC,IL,LFIX) I=IPAGE(IC,IL) IF(I.EQ.IRIGHT) GO TO 40 IF(I.EQ.N0) IINPUT=8 IF(I.EQ.N1) IINPUT=12 IF(I.EQ.N2) IINPUT=16 IF(I.EQ.N3) IINPUT=20 DO 24 J=1,7 24 IBUF(J,1)=IBUF(J+1,1) IBUF(8,1)=I IF(.NOT. ( (I.EQ.A).OR.(I.EQ.B).OR.(I.EQ.ISLASH).OR.(I.EQ.IOR) C .OR.(I.EQ.IAND).OR.(I.EQ.ICOLON) ) ) GO TO 21 DO 30 I=1,4 30 FIXBUF(I)=FIXBUF(I+1) FIXBUF(5)=IPAGE(IC,IL) GO TO 21 40 IMATCH=0 DO 60 J=1,14 LMATCH=.TRUE. DO 50 I=1,5 50 LMATCH=LMATCH .AND. ( FIXBUF(I).EQ.TABLE(I,J) ) 60 IF(LMATCH) IMATCH=J IF(IMATCH.EQ.0) GO TO 100 IF(.NOT.LFIRST) GO TO 85 LFIRST=.FALSE. DO 80 I=1,32 LFUSES(I,IPROD)=.TRUE. 80 IBLOW = IBLOW + 1 85 DO 90 I=1,4 IF( (IMATCH-7).LE.0 ) GO TO 90 MYINX = IINPUT + I LFUSES(MYINX,IPROD)=.FALSE. IBLOW = IBLOW - 1 IMATCH=IMATCH-8 90 IMATCH=IMATCH+IMATCH LBUF(1)=.TRUE. CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.FALSE.,ITYPE, C LPROD,IOP,IBLOW) 100 LFIX=.FALSE. CALL INCR(IC,IL,LFIX) RETURN END