Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50034/t2.c3
There are no other files named t2.c3 in the archive.
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