SUBROUTINE TTYOS(M1,ML,MR) C PRINT "*** MESSAGE" ON TTY OUTPUT FILE C C INPUT: C M1=MESSAGE ARRAY NAME. C ML=LEFT BOUND. C MR=RIGHT BOUND. IMPLICIT INTEGER(A-Z) COMMON/MESAGE/MES1,MES1A,MES1B,MES1X,MES2,MES2A,MES2B,MES2X, 1 MES3,MES3A,MES3B,MES3X,MES4,MES4X,MES5,MES5A,MES5B, 2 MES5C,MES5D,MES5X,MES6,MES6X,MES7,MES7X,MES8,MES8A, 3 MES8B,MES8X,MES9,MES9A,MES9B,MES9X,MES10,MES10A, 4 MES10B,MES10X,MES11,MES11X,MES12,MES12X,MES13,MES13X, 5 MES14,MES14X,MES15,MES15X,MES16,MES16X,MES17,MES17X, 6 MES18,MES18X,MES19,MES19X,MES20,MES20A,MES20B,MES20C, 7 MES20D,MES20X,MES21,MES21X,MES22,MES22X,MES23,MES23A, 8 MES23B,MES23X,MES24,MES25,MES25X,MES26,MES26X, 9 MES27,MES27A,MES27B,MES27C,MES27D,MES27X,MES28,MES28X, 1 MES29,MES29A,MES29B,MES29C,MES29D,MES29E,MES29F,MES29X, 2 MES30,MES30X,MES31,MES31X,MES32,MES32A,MES32B,MES32C, 3 MES32D,MES32X,MES33,MES33A,MES33B,MES33C,MES33D,MES33X 4 ,MES20E,MES20F,MES24X DIMENSION MES1(6),MES2(3),MES3(5),MES4(2),MES5(3),MES6(1),MES7(1), 1 MES8(3),MES9(2),MES10(2),MES11(1),MES12(1),MES13(2),MES14(2), 2 MES15(3),MES16(2),MES17(1),MES18(3),MES19(3),MES20(6),MES21(1) 3 ,MES22(1),MES23(4),MES24(1),MES25(1),MES26(2),MES27(7), 4 MES28(2),MES29(5),MES30(2),MES31(1),MES32(3),MES33(2) DIMENSION M1(1) CALL TTYO(MES6,1,MES6X,2) CALL TTYO(M1,ML,MR,3) RETURN END SUBROUTINE DATER(I,J,JJ) C PRINT "DATA ERROR I:J JJ" ON CONSOLE. C INPUT: C I=DEVICE NAME. C J=FILE NAME C JJ=DEVICE STATUS REGISTER IMPLICIT INTEGER(A-Z) COMMON/MESAGE/MES1,MES1A,MES1B,MES1X,MES2,MES2A,MES2B,MES2X, 1 MES3,MES3A,MES3B,MES3X,MES4,MES4X,MES5,MES5A,MES5B, 2 MES5C,MES5D,MES5X,MES6,MES6X,MES7,MES7X,MES8,MES8A, 3 MES8B,MES8X,MES9,MES9A,MES9B,MES9X,MES10,MES10A, 4 MES10B,MES10X,MES11,MES11X,MES12,MES12X,MES13,MES13X, 5 MES14,MES14X,MES15,MES15X,MES16,MES16X,MES17,MES17X, 6 MES18,MES18X,MES19,MES19X,MES20,MES20A,MES20B,MES20C, 7 MES20D,MES20X,MES21,MES21X,MES22,MES22X,MES23,MES23A, 8 MES23B,MES23X,MES24,MES25,MES25X,MES26,MES26X, 9 MES27,MES27A,MES27B,MES27C,MES27D,MES27X,MES28,MES28X, 1 MES29,MES29A,MES29B,MES29C,MES29D,MES29E,MES29F,MES29X, 2 MES30,MES30X,MES31,MES31X,MES32,MES32A,MES32B,MES32C, 3 MES32D,MES32X,MES33,MES33A,MES33B,MES33C,MES33D,MES33X 4 ,MES20E,MES20F,MES24X DIMENSION MES1(6),MES2(3),MES3(5),MES4(2),MES5(3),MES6(1),MES7(1), 1 MES8(3),MES9(2),MES10(2),MES11(1),MES12(1),MES13(2),MES14(2), 2 MES15(3),MES16(2),MES17(1),MES18(3),MES19(3),MES20(6),MES21(1) 3 ,MES22(1),MES23(4),MES24(1),MES25(1),MES26(2),MES27(7), 4 MES28(2),MES29(5),MES30(2),MES31(1),MES32(3),MES33(2) DIMENSION I(1), J(1) K=MES20B-MES20A+1 L=MES20D-MES20C+1 CALL MOVE(MES20,MES20A,I,1,K) CALL MOVE(MES20,MES20C,J,1,L) CALL SETB(MES20,MES20E,MES20F-MES20E+1) IF(JJ.NE.0)CALL CHA(MES20,MES20E,MES20F,JJ) CALL LIST(MES20,1,MES20X,4) RETURN END SUBROUTINE TTYO(M,IL,IRR,I) C PRINT MESSAGE ON TTY OUTPUT FILE. C C INPUT: C M=MESSAGE ARRAY. C IL=LEFT BOUND. C IRR=RIGHT BOUND. C I=1-NO CR,LF C =2-CR,LF BEFORE. C =3-CR,LF, AFTER. C =4-CR,LF,BEFORE AND AFTER. IMPLICIT INTEGER(A-Z) COMMON/GEN1/ IC,OP,IR,IOLINK,STOP(8),STOPC(8),CAR,RESULT,BW,CAD, 1 BRKN,DEV,FIL,FILN,IRET,NOTYO,NOTYI,SG,SGA,SUBOPA, 2 TYEQTY,ADSTOP,ADSTCL,ADSTFL,ADSTAD,TR1,TR2,TR3,TIME,TIMES, 3 TTYSRC,SERMSK,SERLOW,SERHI,TYOERR,TDEV,TFIL,GROUP,GROUPA,OVR EQUIVALENCE(TI,T1) COMMON /GEN2/ PTIDEV,PTIFIL,PTODEV,PTOFIL,TIDEV,TIFIL,NOPTI, 1 NOPTO,PUNCH,GENIOR,TYISTY COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION DIMENSION M(1) C SUPPRESS IF TTY OUTPUT GOING TO CONSOLE OR C IF NO TTY FILE DEFINED. IF(TYEQTY.NE.0)RETURN IF(NOTYO.EQ.0)RETURN IF(I.EQ.2.OR.I.EQ.4)CALL CRLFT DO 2 K=IL,IRR CALL MOVE(L,1,M,K,1) CALL BXT(N1,L,0,CHRLEN-1) CALL PRT(N1,N2) IF(N2.EQ.2)GO TO TYOERR 2 CONTINUE IF(I.EQ.3.OR.I.EQ.4)CALL CRLFT IF(TYISTY.EQ.0)RETURN C IF TTY OUTPUT GOING TO A TTY OTHER THAN CONSOLE, C FORCE AN OUTPUT. 3 N1=0 CALL PRT(N1,N2) IF(N2.EQ.2)GO TO TYOERR IF(N2.NE.1)GO TO 3 RETURN END SUBROUTINE CRLFC C PRINT CR,LF ON CONSOLE. IMPLICIT INTEGER(A-Z) COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION N1=CR CALL CWCS(N1,N2) N1=LF CALL CWCS(N1,N2) RETURN END SUBROUTINE CRLFT C PRINT CR,LF ON TTY OUTPUT FILE. IMPLICIT INTEGER(A-Z) COMMON/GEN1/ IC,OP,IR,IOLINK,STOP(8),STOPC(8),CAR,RESULT,BW,CAD, 1 BRKN,DEV,FIL,FILN,IRET,NOTYO,NOTYI,SG,SGA,SUBOPA, 2 TYEQTY,ADSTOP,ADSTCL,ADSTFL,ADSTAD,TR1,TR2,TR3,TIME,TIMES, 3 TTYSRC,SERMSK,SERLOW,SERHI,TYOERR,TDEV,TFIL,GROUP,GROUPA,OVR EQUIVALENCE(TI,T1) COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION N1=CR CALL PRT(N1,N2) IF(N2.EQ.2)GO TO TYOERR N1=LF CALL PRT(N1,N2) IF(N2.EQ.2)GO TO TYOERR RETURN END SUBROUTINE LIST(M,IL,IR,I) C PRINT MESSAGE ON CONSOLE. C INPUTS: SAME AS TTYO. IMPLICIT INTEGER(A-Z) COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION DIMENSION M(1) IF(I.EQ.2.OR.I.EQ.4)CALL CRLFC DO 1 K=IL,IR CALL MOVE(L,1,M,K,1) CALL BXT(N1,L,0,CHRLEN-1) 1 CALL CWCS(N1,N2) IF(I.EQ.3.OR.I.EQ.4)CALL CRLFC N1=0 2 CALL CWCS(N1,N2) IF(N2.EQ.0)GO TO 2 RETURN END SUBROUTINE FME(AA,R,E) C FETCH A BYTE FROM MEMORY OR EXT PAGE. C INPUT: C AA=ADDRESS OF BYTE. C OUTPUT: C R=RESULT, RIGHT JUSTIFIED. C E=0-OK; 1-ILLEGAL. IMPLICIT INTEGER(A-Z) COMMON/MEM/MEM(4096),MEMROL,MEMROH,ROMF,MEMH ,MEMLIM COMMON/SCRATCH/REGISTER(9),SAV(9) EQUIVALENCE (LP,REGISTER(8)),(PC,REGISTER(9)),(ST,REGISTER(1)) EQUIVALENCE (ST,STATUS) COMMON/GEN1/ IC,OP,IR,IOLINK,STOP(8),STOPC(8),CAR,RESULT,BW,CAD, 1 BRKN,DEV,FIL,FILN,IRET,NOTYO,NOTYI,SG,SGA,SUBOPA, 2 TYEQTY,ADSTOP,ADSTCL,ADSTFL,ADSTAD,TR1,TR2,TR3,TIME,TIMES, 3 TTYSRC,SERMSK,SERLOW,SERHI,TYOERR,TDEV,TFIL,GROUP,GROUPA,OVR EQUIVALENCE(TI,T1) COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION COMMON/XTCH/XTCH,XTCHAD COMMON/XPG/XPG,XPGI,XPGJ,TIMEX DIMENSION XPG(30,10) E=0 A=AA C CLASS A AND TEST FOR LEGALITY. CALL MEMLEG(A,I,J) C DISPATCH ON CLASS. MAIN,ROM,EXT PG OR ILLEGAL. GO TO (8,8,5,6),J+1 C DISPATCH ON TYPE. OK,BAD,READ STOP,WRITE STOP,R/W STOP. 8 GO TO (1,2,3,1,3),I+1 C FETCH FROM MAIN MEMORY ARRAY, MEM. 1 A1=A/NUMINW+1 A2=(A-A/NUMINW*NUMINW)*8 A3=A2+7 A4=MEM(A1) CALL BXT(R,A4,A2,A3) TIME=TIME+1 RETURN 2 E=1 RETURN C CHECK FOR READ STOP. 3 IF(ADSTCL.EQ.1 .OR. ADSTCL.EQ.3)ADSTFL=1 ADSTAD=IC GO TO 1 6 GO TO 2 C EXT PG. DISPATCH ON TYPE. 5 CONTINUE GOTO(30,2,31,30,31),I+1 C CHECK FOR READ STOP. 31 IF(ADSTCL.EQ.1.OR.ADSTCL.EQ.3)ADSTFL=1 ADSTAD=IC C FIND WHERE ADDRESS IS IN EXT PAGE. 30 T1=A F=0 CALL ODD(T1,EE) IF(EE.EQ.0)GO TO 10 T1=A-1 F=1 10 CONTINUE IF(T1.EQ.XTCHAD)GOTO13 IF(T1.EQ.ACC)GOTO 12 IF(A.LT. SCRBEG .OR. A.GT. SCREND)GO TO 2 DO 40 I=1,XPGI J=XPG(I,1) IF(J.NE.0.AND.A.EQ.J)GOTO 41 40 CONTINUE GO TO 2 C STATUS REG. 12 EE=STATUS 14 IF(F.NE.0)CALL BXT(R,EE,WM15,WM8) IF(F.EQ.0)R=EE GO TO 9 C SWITCH REGISTER. 13 EE=XTCH GOTO 14 C DEVICE REGISTER. 41 R=XPG(I,2) CALL LANC(R,XPG(I,4)) T1=XPG(I,5) GOTO(50,51,52,53),T1+1 50 CONTINUE 51 T1=1 GOTO 54 52 CONTINUE 53 T1=3 54 XPG(I,5)=T1 9 CALL LAND(R,ML) RETURN END SUBROUTINE FMW(A,R,E) C FETCH A WORD FROM MEMORY ON EXT PAGE. C INPUT: C A=ADDRESS OF WORD. C OUTPUT: C R=RESULT. C E=0-OK; 1-ILLEGAL IMPLICIT INTEGER(A-Z) COMMON/GEN1/ IC,OP,IR,IOLINK,STOP(8),STOPC(8),CAR,RESULT,BW,CAD, 1 BRKN,DEV,FIL,FILN,IRET,NOTYO,NOTYI,SG,SGA,SUBOPA, 2 TYEQTY,ADSTOP,ADSTCL,ADSTFL,ADSTAD,TR1,TR2,TR3,TIME,TIMES, 3 TTYSRC,SERMSK,SERLOW,SERHI,TYOERR,TDEV,TFIL,GROUP,GROUPA,OVR EQUIVALENCE(TI,T1) E=0 T1=TIME CALL MEMLEG(A+1,I,J) IF(I.NE.1)GO TO 1 2 E=1 RETURN 1 CALL FME(A,R1,I) IF(I.NE.0)GO TO 2 CALL FME(A+1,R2,I) IF(I.NE.0) GO TO 2 R=R2*2**8 +R1 IF(T1.NE.TIME)TIME=TIME-1 RETURN END SUBROUTINE SME(AA,R,E) C STORE A BYTE IN MEMORY OR EXT PAGE. C INPUT: C A=ADDRESS C R=DATA TO STORE. C OUTPUT: C E=0-OK; 1-ILLEGAL IMPLICIT INTEGER(A-Z) COMMON/MEM/MEM(4096),MEMROL,MEMROH,ROMF,MEMH ,MEMLIM COMMON/SCRATCH/REGISTER(9),SAV(9) EQUIVALENCE (LP,REGISTER(8)),(PC,REGISTER(9)),(ST,REGISTER(1)) EQUIVALENCE (ST,STATUS) COMMON/GEN1/ IC,OP,IR,IOLINK,STOP(8),STOPC(8),CAR,RESULT,BW,CAD, 1 BRKN,DEV,FIL,FILN,IRET,NOTYO,NOTYI,SG,SGA,SUBOPA, 2 TYEQTY,ADSTOP,ADSTCL,ADSTFL,ADSTAD,TR1,TR2,TR3,TIME,TIMES, 3 TTYSRC,SERMSK,SERLOW,SERHI,TYOERR,TDEV,TFIL,GROUP,GROUPA,OVR EQUIVALENCE(TI,T1) COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION COMMON/XTCH/XTCH,XTCHAD COMMON/GEN5/STDEST C C~ DEVICE REGISTERS IN EXTERNAL PAGE. C C XPG(I,1)=ADDRESS OF BYTE I. C XPG(I,2)=CONTENTS OF BYTE I. C XPG(I,3)=READ ONLY MASK. SET A 1 FOR A READ ONLY BIT. C XPG(I,4)=WRITE ONLY MASK. SET A 1 FOR EACH WRITE ONLY BIT. C XPG(I,5)=ACCESS FLAG. 0=NOT ACCESSED. C 1=READ. C 2=WRITTEN. C 3=BOTH. C XPG(I,6)=POWER UP CONTENTS OF BYTE I. C XPG(I,7-10)=NOT DEFINED. C C C XPGI AND XPGJ ARE LIMITS ON I,J DIMENSIONS OF XPG. C TIMEX IS THE TIMER FOR DEVICE FUNCTIONS C C COMMON/XPG/XPG,XPGI,XPGJ,TIMEX DIMENSION XPG(30,10) E=0 A=AA J=R CALL LAND(J,ML) C CLASS THE ADDRESS AND DISPATCH. CALL MEMLEG(A,I,K) GO TO (7,2,5,6),K+1 7 GO TO (1,2,1,4,4),I+1 C STORE IN MEMORY. 1 A1=A/NUMINW+1 A2=(A-A/NUMINW*NUMINW)*8 A3=A2+7 A4=MEM(A1) CALL BTX(A4,A2,A3,J) MEM(A1)=A4 TIME=TIME+1 RETURN 2 E=1 RETURN 4 IF(ADSTCL.EQ.2.OR.ADSTCL.EQ.3)ADSTFL=1 ADSTAD=IC 3 GO TO 1 C STORE IN EXT PAGE. 5 CONTINUE GOTO(30,2,30,31,31),I+1 31 IF(ADSTCL.GE.2)ADSTFL=1 ADSTAD=IC 30 T1=A T2=WM0 T3=WM7 CALL ODD(T1,EE) IF(EE.EQ.0)GO TO 8 T1=A-1 T2=WM8 T3=WM15 8 CONTINUE IF(T1.EQ.XTCHAD)GOTO11 IF(T1.EQ.ACC)GOTO 10 IF(A.LT. SCRBEG .OR. A.GT. SCREND)GOTO 2 DO 40 I=1,XPGI K=XPG(I,1) IF(K.NE.0.AND.A.EQ.K)GOTO 41 40 CONTINUE GO TO 2 C DEVICE REG. 41 T1=XPG(I,3) T2=XPG(I,2) CALL LAND(T2,T1) CALL LANC(J,T1) XPG(I,2)=T2+J T1=XPG(I,5) GOTO(50,51,52,53),T1+1 50 CONTINUE 52 T1=2 GOTO 54 51 CONTINUE 53 T1=3 54 XPG(I,5)=T1 RETURN C SWITCH REG. 11 T1=XTCH CALL BTX(T1,T3,T2,R) XTCH=T1 RETURN C STATUS REG. 10 T1=STATUS CALL BTX(T1,T3,T2,R) STATUS=T1 C SET FLAG THAT STATUS REG WAS STORED INTO. STDEST=1 RETURN 6 GO TO 2 END SUBROUTINE SMW(A,R,E) C STORE A WORD C INPUT: C A=ADDRESS C R=DATA TO STORE. C OUTPUT: C E=0-OK; 1-ILLEGAL IMPLICIT INTEGER(A-Z) COMMON/GEN1/ IC,OP,IR,IOLINK,STOP(8),STOPC(8),CAR,RESULT,BW,CAD, 1 BRKN,DEV,FIL,FILN,IRET,NOTYO,NOTYI,SG,SGA,SUBOPA, 2 TYEQTY,ADSTOP,ADSTCL,ADSTFL,ADSTAD,TR1,TR2,TR3,TIME,TIMES, 3 TTYSRC,SERMSK,SERLOW,SERHI,TYOERR,TDEV,TFIL,GROUP,GROUPA,OVR EQUIVALENCE(TI,T1) COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION E=0 T1=TIME CALL MEMLEG(A+1,I,J) IF(J.EQ.1)GO TO 2 IF(I.NE.1)GO TO 1 2 E=1 RETURN 1 J=R CALL LAND (J,ML) K=R CALL LAND(K,MH) K=K/SL8 CALL SME(A,J,I) IF(I.NE.0)GO TO 2 CALL SME(A+1,K,I) IF(I.NE.0)GO TO 2 IF(T1.NE.TIME)TIME=TIME-1 RETURN END SUBROUTINE GC(IR) C GET THE C BIT. C OUTPUT: C BIT(0 OR 1) IMPLICIT INTEGER(A-Z) I=1 CALL GET(IR,I) RETURN END SUBROUTINE GN(IR) C GET THE N BIT. IMPLICIT INTEGER(A-Z) I=8 CALL GET(IR,I) RETURN END SUBROUTINE GZ(IR) C GET THE Z BIT. IMPLICIT INTEGER(A-Z) I=4 CALL GET(IR,I) RETURN END SUBROUTINE GV(IR) C GET THE V BIT. IMPLICIT INTEGER(A-Z) I=2 CALL GET(IR,I) RETURN END SUBROUTINE GET(J,I) C GET A BIT FROM STATUS REG. C INPUT: I=MASK TO SELECT BIT. C OUTPUT: J=BIT RIGHT JUSTIFIED. IMPLICIT INTEGER(A-Z) COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION CALL FME(ACC,K,L) CALL LAND(K,I) J=K/I RETURN END SUBROUTINE SC(IR) C SET THE C BIT C INPUT: IR=0-CLEAR BIT. C IR NOT 0-SET BIT. IMPLICIT INTEGER(A-Z) I=1 CALL SET(I,IR) RETURN END SUBROUTINE SN(IR) C SET THE N BIT. IMPLICIT INTEGER(A-Z) I=8 CALL SET(I,IR) RETURN END SUBROUTINE SZ(IR) C SET THE Z BIT IMPLICIT INTEGER(A-Z) I=4 CALL SET(I,IR) RETURN END SUBROUTINE SV(IR) C SET THE V BIT. IMPLICIT INTEGER(A-Z) I=2 CALL SET(I,IR) RETURN END SUBROUTINE SET(L,N) C SET A BIT IN STATUS REG. C INPUT: L IS MASK TO SELECT BIT. C IR=0-CLEAR BIT. C IR NOT 0-SET BIT. IMPLICIT INTEGER(A-Z) COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION COMMON/GEN5/STDEST CALL FME(ACC,I,J) M=L CALL LNOT(M) CALL LAND(I,M) IF(N.NE.0)I=I+L T1=STDEST CALL SME(ACC,I,J) STDEST=T1 RETURN END SUBROUTINE COMC C COMPLEMENT THE C BIT. CALL GC(I) CALL LXOR(I,1) CALL SC(I) RETURN END SUBROUTINE COMV C COMPLEMENT THE V BIT. CALL GV(I) CALL LXOR(I,1) CALL SV(I) RETURN END SUBROUTINE SEXT(I) C SIGN EXTEND THE BYTE IN I. C RETURN RESULT IN I. IMPLICIT INTEGER (A-Z) COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION CALL LAND (I,ML) J=I CALL LAND (J,C2T7) IF (J.EQ.0) RETURN I=I+MH RETURN END SUBROUTINE MLOAD(ER) C ABSOLUTE LOADER. C OUTPUT: ER=0-OK; 1-ERROR C INPUT: BINARY PROG IMPLICIT INTEGER(A-Z) COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION DIMENSION T1(2) EQUIVALENCE (PT,T1(2)),(CT,T1(1)) ER=0 C LOOK FOR START OF BLOCK. 4 CALL GDA(N,E) IF(E.GE.2)GO TO 2 IF(N.EQ.1)GO TO 5 GO TO 4 5 CKSM=1 CALL GDA (N,E) IF (E.GE.2)GOTO2 J=1 C READ IN BYTE COUNT, LOAD ADDRESS DO 1 I=1,4 CALL GDA(N,E) IF(E.GE.2)GO TO 2 CALL ODD (I,K) CKSM=CKSM+N IF (K.EQ.0)GOTO 7 T2=N GOTO 1 7 T2=T2+N*SL8 T1(J)=T2 J=J+1 1 CONTINUE C CALCULATE AMOUNT OF DATA. IF NONE, WE'RE DONE. CT=CT-6 IF (CT.EQ.0)GOTO6 C READ AND LOAD DATA 3 CALL GDA(N,E ) IF(E.GE.2)GO TO 2 CKSM=CKSM+N CALL SME(PT,N,E) IF(E. NE.0)GO TO 2 PT=PT+1 CT=CT-1 IF(CT.GT.0)GO TO 3 C READ AND CHECK THE CHECKSUM. CALL GDA (N,E) IF (E.GE.2)GOTO2 CKSM=CKSM+N CALL LAND(CKSM,ML) IF(CKSM.EQ.0)GO TO 4 2 ER=1 6 CALL FIN(BIN,E) IF(E.EQ.2)ER=1 RETURN END SUBROUTINE MDMP(L,H,FORM,ER) C MEMORY DUMP. C INPUT: L=LOW ADDRESS. C H=HI ADDRESS. C FORM=0-ABS; 1-BOOT (NOT USED) C OUTPUT: C ER=0-0K; 1-ERROR. IMPLICIT INTEGER(A-Z) COMMON/CONST/MH,ML,MAL,MALC,MLC,M7,M8,SCRBEG,SCREND,C2T7,C2T15, 1 TYO,CON,TYI,BIN,TTYNAM,PTRNAM,DSKNAM,TTOFIL,TTIFIL, 2 NUMINW,CR,LF,TAB,CHRLEN,WRDLEN,B,DOL,BLANK,EQUALS,COMMA, 3 WM0,WM1,WM2,WM3,WM4,WM5,WM6,WM7,WM8,WM9,WM10,WM11,WM12, 4 WM13,WM14,WM15,SL8,APC,ACC,ADR0, 5 TSTION DIMENSION IDAT (7) C CANNED DATA FOR TRANSFER BLOCK. DATA (IDAT(I),I=1,7)/1,0,6,0,1,0,-8/ ER=0 MAX=64 PT=L IF(L.GT.H)GO TO 1 IF(FORM.EQ.1)GO TO 2 C INIT CHECKSUM. PUNCH BLOCK START C FRAME AND NULL FRAME 3 CKSM=1 CALL WDA(1,E) IF(E.EQ.2)GO TO 1 CALL WDA(0,E) IF(E.EQ.2)GOTO 1 C CALCULATE ADDRESSES AND COUNTS FOR THIS BLOCK. T1=PT N=MAX IF(H-PT.LT.MAX-1)N=H-PT+1 N2=N+6 C PUNCH BYTE COUNT, LOAD ADDRESS. CALL WDA(N2,E) IF(E.EQ.2)GOTO 1 CKSM=CKSM+N2 N2=N2/SL8 CALL WDA(N2,E) CKSM=CKSM+N2 IF (E.EQ.2)GOTO 1 CALL WDA(T1,E) CKSM=CKSM+T1 T1=T1/SL8 IF(E.EQ.2)GOTO 1 CALL WDA(T1,E) CKSM=CKSM+T1 IF(E.EQ.2)GOTO 1 C DUMP DATA. DO 5 II=1,N CALL FME(PT,N1,E) CALL WDA( N1,E) IF(E.EQ.2)GO TO 1 CKSM=CKSM+N1 PT=PT+1 5 CONTINUE C CALCULATE AND PUNCH CHECKSUM. CKSM=-CKSM DO 6 II=1,10 C ALL WDA(CKSM,E) IF(E.EQ.2)GOTO 1 CKSM=0 6 CONTINU E C TEST FOR END. IF(PT.LE.H)GO TO 3 C PUNCH TRANSFER BLOCK. DO 12 I=1,7 T1=IDAT(I) CALL WDA(T1,E) 12 CONTINUE GOTO 7 1 ER=1 7 CALL FIN(BIN, E) RETURN 2 N=H-L+1 DO 8 II=1,N CALL WDA(1,E) IF(E.EQ.2)GO TO 1 CALL FME(PT,N1,E) IF( E.NE.0)GO TO 1 CALL WDA(N1,E) IF(E.EQ.2 )GO TO 1 PT=PT+1 8 CONTINUE CALL WDA(2,E) IF(E.NE.2)GOTO 7 GOTO 1 END