Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50034/t1.c8
There are no other files named t1.c8 in the archive.
BLOCK DATA
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/CNTRLC/CNTRLC
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
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)
COMMON/MESAG2/MES34,MES34X,MES35,MES35X,MES36,MES36X,
1 MES37,MES37X
DIMENSION MES34(2),MES35(1),MES36(1),MES37(6)
COMMON/GEN3/SOUR,DEST,SD,DD,SM,DM,SREG,DREG
COMMON/CHAR/LEGALF,NUM,COMMND,COMMNN,SHIFT,CNTRLU,RUBOUT,
1 ALTMD1,ALTMD2,ALTMD3,DOLLFT,BLANKL ,LEGALN,NUMN,TABLFT,ICHAR,
2 COLON,SLASH
DIMENSION LEGALF(4),NUM(2),COMMND(40,2)
EQUIVALENCE (CRLEFT,COMMND(25,1)),(ARO,COMMND(27,1)),
1 (BARO,COMMND(26,1)),(LFLEFT,COMMND(29,1)),(BLF,COMMND(28,1))
COMMON/LPOVAD/LPOVAD,LPOVFL,TRAF,WAITF
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)
C
C DEVICE CHARACTERISTICS TABLE. FOR EACH DEVICE I, THE CURRENT
C STATUS IS HELD IN THIS TABLE.
C
C I=1 FOR KBD,LSR.
C I=2 FOR TTY,LSP.
C I=3 FOR HSR.
C I=4 FOR HSP.
C
C
C DCH(I,1)=TIME INTERVAL FOR DOING FUNCTION.
C DCH(I,2)=TIME AT LAST SELECT.
C DCH(I,3)=DEVICE PRIORITY.
C DCH(I,4)=ADDRESS OF INTERRUPT VECTOR.
C DCH(I,5)=INTERRUPT REQUEST FLAG.
C DCH(I,6)=INTERRUPT ENABLE BIT ON LAST CYCLE.
C DCH(I,7)=EOF INDICATOR(OUT OF TAPE).
C DCH(I,8-10)=NOT DEFINED.
C
C
C DCHI AND DCHJ ARE LIMITS ON I,J DIMENSIONS OF DCH
C NUMDEV IS THE CURRENT NUMBER OF DEVICES
C
COMMON/DCH/DCH,DCHI,DCHJ,NUMDEV
DIMENSION DCH(10,10)
COMMON/POWTWO/ CT0,CT1,CT2,CT3,CT4,CT5,CT6,CT7
C
C
C DEVICE INDEXES
C
C
COMMON/DEVINX/DEVINX
DIMENSION DEVINX(10,6)
C
C
DATA TYO/2/,CON/0/,TYI/3/,BIN/1/,TTYNAM/3HTTY/,DSKNAM/3HDSK/,
1 PTRNAM/3HPTR/,TTIFIL/3HTTI/,TTOFIL/3HTTO/,PUNCH/4/
DATA MEMLIM/16383/,NUMINW/4/
DATA TSTION/6/
DATA CR/13/,LF/10/,TAB/9/,CHRLEN/7/,WRDLEN/36/,B/1HB/,DOL/1H$/
DATA BLANK/1H /,EQUALS/1H=/,COMMA/1H,/,ICHAR/1HI/
DATA COLON/1H:/,SLASH/1H//
DATA LPOVAD/256/
C
C SET UP PARAMETERS FOR XPG
C
C
C ADDRESSES OF BYTES
C
DATA (XPG(I,1),I=1,30) /65392,65393,65394,65395,65396,65397,
1 65398,65399,65384,65385,65386,65387,
1 65388,65389,65390,65391,14*0/
DATA SCRBEG/65384/, SCREND/65399/
C
C READ ONLY BIT MASKS
C
DATA (XPG(I,3),I=1,30) /128,8,255,0,128,0,0,0
1 ,128,136,255,0
1 ,128,128,0,0,14*0/
C
C WRITE ONLY BIT MASKS
C
DATA (XPG(I,4),I=1,30) /59,247,0,255,59,255,255,255
1 ,63,119,0,255,63,127,255,255
2 ,14*0/
C
C POWER UP STATES
C
DATA (XPG(I,6),I=1,30) /0,0,0,0,128,0,0,0,0,0,0,0
1 ,128,0,0,0,14*0/
C
C XPG LIMITS
C
DATA XPGI/30/, XPGJ/10/
C
C SET UP PARAMETERS FOR DCH
C
C
C KBD/LSR
C
DATA (DCH(1,I),I=1,4) /128,0,4,48/
C
C LSP
C
DATA (DCH(2,I),I=1,4) /128,0,4,52/
C
C HSR
C
DATA (DCH(3,I),I=1,4) /64,0,4,56/
C
C HSP
C
DATA (DCH(4,I),I=1,4) /124,0,4,60/
C
C LIMITS
C
DATA DCHI/10/,DCHJ/10/
C
C SET UP POWERS OF TWO
C
DATA CT0/1/, CT1/2/, CT2/4/, CT3/8/, CT4/16/,CT5/32/
1 , CT6/64/, CT7/128/
C
C SET DEVINX---INDEXES INTO XPG FOR DEVICE I.
C
DATA (DEVINX(1,I),I=1,4)/1,2,3,4/,
1 (DEVINX(2,I),I=1,4)/5,6,7,8/,
2 (DEVINX(3,I),I=1,4)/9,10,11,12/,
3 (DEVINX(4,I),I=1,4)/13,14,15,16/
C
C SET NUMBER OF DEVICES
C
DATA NUMDEV/4/
C
C CANNED MESSAGES.
C MESNA=LEFT LIMIT OF VARIABLE FIELD #1.
C MESNB=RIGHT LIMIT OF VARIABLE FIELD #1.
C MESNC,MESND=LIMITS OF FIELD #2.
C
C MESNX=LENGTH OF MESSAGE.
C
C
DATA MES1/ 30HBAD MEMORY REFERENCE AT /,MES1A/25/,MES1B/30/,
1 MES1X/30/
DATA MES2/ 14HHALT AT /,MES2A/9/,MES2B/14/,MES2X/14/
DATA MES3/ 21HBAD OP-CODE AT /,MES3A/16/,MES3B/21/,MES3X/21/
DATA MES4/ 10HLOAD ERROR/,MES4X/10/
DATA MES5/ 12HST$ , /,MES5A/4/,MES5B/9/,MES5C/11/,MES5D/11/,
1 MES5X/12/
DATA MES6/ 3H***/,MES6X/3/
DATA MES7/ 1H?/,MES7X/1/
DATA MES8/ 11H*** G$/,MES8A/4/,MES8B/9/,MES8X/11/
DATA MES9/ 10H /,MES9A/3/,MES9B/8/,MES9X/10/
DATA MES10/ 7H*** ST$/,MES10A/4/,MES10BB/4/,MES10X/7/
DATA MES11/ 5H***R$/,MES11X/5/
DATA MES12/ 5H*OBJ /,MES12X/5/
DATA MES13/10HBAD DEVICE/,MES13X/10/
DATA MES14/ 8HBAD FILE/,MES14X/8/
DATA MES17/ 2H R/,MES17X/2/
DATA MES18/13HCOMMAND ERROR/,MES18X/13/
DATA MES20/29HDATA ERROR : /,MES20A/12/,
1 MES20B/16/,
1 MES20C/18/,MES20D/21/,MES20X/29/,MES20E/24/,MES20F/29/
DATA MES21/ 5H*TTY /,MES21X/5/
DATA MES22/ 5H*LSR /,MES22X/5/
DATA MES23/16HSYSTEM ERROR /,MES23A/14/,MES23B/16/,MES23X/16/
DATA MES24/ 1H /,MES24X/1/
DATA MES25/ 4HDMP /,MES25X/4/
DATA MES26/ 9H*MEM-DMP /,MES26X/9/
DATA MES27/32HADDRESS STOP AT BY /,MES27A/17/,
1 MES27B/22/,MES27C/27/,MES27D/32/,MES27X/32/
DATA MES29/24HTRACE /,MES29A/7/,MES29B/12/,
1 MES29C/14/,MES29D/19/,MES29E/21/,MES29F/24/,MES29X/24/
DATA MES30/ 6H*CORE /,MES30X/6/
DATA MES31/ 5H*ROM /,MES31X/5/
DATA MES32/15H / /,MES32A/1/,MES32B/6/,MES32C/8/,
1 MES32D/13/,MES32X/15/
DATA MES34/10HDUMP ERROR/,MES34X/10/
DATA MES35/5H*HSP /,MES35X/5/
DATA MES36/5H*HSR /,MES36X/5/
DATA MES37/27HR0=XXXXXXXXXXXXXXXXXXXXXXXX/,MES37X/3/
DATA LEGALF/18HBCEGIKLMNOPRSTVWXZ/,LEGALN/18/
DATA NUM/10H01234567 /,NUMN/8/
C ODT COMMAND ARRAY.
C COLUMN 1 HOLDS COMMAND CHARACTERS.
C COLUMN 2 HOLDS CORRESPONDING COMMAND INDEX.
DATA COMMNN/39/
DATA (COMMND(I,1),I=1,35 )/2HG$,1H$,2HB$,2HR$,2HK$,3HST$,3HTI$,
1 3HLI$,2HM$,2HX$,3HXB$,3HET$,3HPC$,3HRG$,2HV$,2HC$,2HN$,2HZ$
2 ,2HP$,3HTR$,2HS$,3HSR$,3HSW$,3HSE$,0,0,0,0,0,3HRC$,3HLS$
2 ,3HSI$,5HOLSR$,5HOHSR$,3HXE$/,
3 (COMMND(I,2),I=1,35 )/1,3,2,13,12,10,19,15,14,17,16,35,4,
4 9,5,6,7, 8,11,18,20,21,22,36,33,25,29,23,24,32,31,30,27,28,26/
DATA (COMMND(I,1),I=36,39)/4HCON$,3HDR$,3HDI$,3HDP$/,
1 (COMMND(I,2),I=36,39)/37,38,39,40/
END
SUBROUTINE GCOMD(N,N1,N2,E)
C GET ODT COMMAND
C
C OUTPUTS:
C N=COMMAND INDEX
C N1=-1 IF NO FIRST ARG.
C =VALUE IF FIRST ARG PRESENT.
C N2=-1 IF NO SECOND ARG.
C =VALUE IF SECOND ARG PRESENT.
C E=0 FOR NO ERROR; 1 FOR ERROR
C
IMPLICIT INTEGER(A-Z)
COMMON/NOTYOA/NOTYOA
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/CNTRLC/CNTRLC
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/CHAR/LEGALF,NUM,COMMND,COMMNN,SHIFT,CNTRLU,RUBOUT,
1 ALTMD1,ALTMD2,ALTMD3,DOLLFT,BLANKL ,LEGALN,NUMN,TABLFT,ICHAR,
2 COLON,SLASH
DIMENSION LEGALF(4),NUM(2),COMMND(40,2)
EQUIVALENCE (CRLEFT,COMMND(25,1)),(ARO,COMMND(27,1)),
1 (BARO,COMMND(26,1)),(LFLEFT,COMMND(29,1)),(BLF,COMMND(28,1))
2 E=0
N=0
F1=0
F2=0
F3=0
F4=0
F5=0
F6=0
F7=0
N1=-1
N2=-1
C READ A CHAR AND LEFT JUSTIFY IN CL.
1 CALL CRCS(C)
CALL BTX(CL,0,CHRLEN-1,C)
C LOOK FOR SPECIAL CHARS.
CALL CAM(K,CL,1,CNTRLU,1,1)
IF(K.EQ.0)GO TO 4
CALL CAM(K,CL,1,ALTMD1,1,1)
IF(K.EQ.0)CL=DOLLFT
CALL CAM(K,CL,1,ALTMD2,1,1)
IF(K.EQ.0)CL=DOLLFT
CALL CAM(K,CL,1,ALTMD3,1,1)
IF(K.EQ.0)CL=DOLLFT
CALL CAM(K,CL,1,BLANK,1,1)
IF(K.EQ.0)GO TO 1
C IF NO ERROR, GO TO 5. OTHERWISE, JUST
C LOOK FOR COMMAND TERMINATOR AND EXIT.
IF(E.EQ.0)GO TO 5
CALL CAM(K,CL,1,DOL,1,1)
IF(K.EQ.0)GO TO 3
CALL CAM(K,CL,1,CRLEFT,1,1)
IF(K.EQ.0)GO TO 3
CALL CAM(K,CL,1,EQUALS,1,1)
IF(K.EQ.0)GO TO 3
CALL CAM(K,CL,1,ARO,1,1)
IF(K.EQ.0)GO TO 3
CALL CAM(K,CL,1,LFLEFT,1,1)
IF(K.EQ.0)GO TO 3
GO TO 1
4 CALL LIST(BLANK,1,1,3)
GO TO 2
C CHECK FOR COMMA.
5 CALL CAM(K,CL,1,COMMA,1,1)
IF(K.EQ.0)GO TO 6
C CHECK FOR NUMBER. IF FOUND, GO TO 8.
DO 7 I=1,NUMN
CALL CAM(J,NUM,I,CL,1,1)
IF(J.EQ.0)GO TO 8
7 CONTINUE
C NOT NUMERIC, CHECK FOR A-Z.
CALL CAM(J,CL,1,1HA,1,1)
CALL CAM(K,CL,1,1HZ,1,1)
IF(J.GE.0.AND.K.LE.0)GOTO 10
C NOT NUMERIC OR A-Z. CHECK FOR TERMINATOR.
CALL CAM(K,CL,1,DOL,1,1)
IF(K.EQ.0)GO TO 11
CALL CAM(K,CL,1,CRLEFT,1,1)
IF(K.EQ.0)GO TO 11
CALL CAM(K,CL,1,EQUALS,1,1)
IF(K.EQ.0)GO TO 11
CALL CAM(K,CL,1,ARO,1,1)
IF(K.EQ.0)GO TO 11
CALL CAM(K,CL,1,LFLEFT,1,1)
IF(K.EQ.0)GO TO 11
C NOT A LEGAL CHARACTER. SET ERROR; RESTART.
12 E=1
GO TO 1
C COMMA SEEN. IF SECOND COMMA, GO SET ERROR.
6 IF(F6.NE.0)GO TO 12
F6=1
C RESET CHARACTER COUNT(F7) AND SET FLAG THAT FIRST ARG SEEN.
F7=0
F2=1
C ERROR IF A-Z ALREADY SEEN.
IF(F1.NE.0)GO TO 12
GO TO 1
C NUMBER SEEN. COUNT IT. ACCUMULATE IN N1 OR N2
C AS DETERMINED BY F2.
8 I=I
IF(F1.NE.0)GOTO 12
F7=F7+1
IF(F7.GE.7)GO TO 12
IF(F2.EQ.0)GO TO 13
C ACCUMULATE NUMBER IN N2.
IF(N2.EQ.-1)N2=0
T6=0
CALL BTX(T6,0,WM3,N2)
N2=T6
I=I-1
N2=N2+I
GO TO 1
C A-Z SEEN. COUNT AND ACCUMULATE IN F3.
10 I=I
F1=1
F4=F4+1
IF(F4.GT.4)GO TO 12
CALL MOVE(F3,F4,CL,1,1)
GO TO 1
C TERMINATOR SEEN. ACCUMULATE IN F3.
11 F4=F4+1
CALL MOVE(F3,F4,CL,1,1)
C SEARCH COMMAND ARRAY.
DO 14 I=1,COMMNN
CALL CAM(J,COMMND(I,1),1,F3,1,F4)
IF(J.EQ.0)GO TO 15
14 CONTINUE
C COMMAND NOT FOUND.
E=1
GO TO 3
C COMMAND FOUND. SET INDEX. IF TERMINATOR IS <CR>,
C DIFFERENTIATE BETWEEN N1<CR> AND N1,N2<CR>.
15 N=COMMND(I,2)
IF(N.NE.33)GO TO 3
IF(N1.NE.-1.AND.N2.NE.-1)N=34
GO TO 3
C ACCUMULATE NUMBER IN N1.
13 IF(N1.EQ.-1)N1=0
T6=0
CALL BTX(T6,0,WM3,N1)
N1=T6
I=I-1
N1=N1+I
GO TO 1
C IF TERMINATOR IS <CR>, GOBBLE UP <LF>.
3 CALL CAM(K,CL,1,CRLEFT,1,1)
IF(K.EQ.0)CALL CRCS(J)
RETURN
END
SUBROUTINE SAVE
C SAVE ALL REGISTERS AND STATUS WORD.
IMPLICIT INTEGER(A-Z)
COMMON/SCRATCH/REGISTER(9),SAV(9)
EQUIVALENCE (LP,REGISTER(8)),(PC,REGISTER(9)),(ST,REGISTER(1))
EQUIVALENCE (ST,STATUS)
DO 1 I=1,9
1 SAV(I)=REGISTER(I)
RETURN
END
SUBROUTINE RESTOR
C RESTORE REGISTERS AND STATUS WORD.
IMPLICIT INTEGER(A-Z)
COMMON/SCRATCH/REGISTER(9),SAV(9)
EQUIVALENCE (LP,REGISTER(8)),(PC,REGISTER(9)),(ST,REGISTER(1))
EQUIVALENCE (ST,STATUS)
DO 1 I=1,9
1 REGISTER(I)=SAV(I)
RETURN
END
SUBROUTINE CLOSE(I,M)
C MODIFY AND CLOSE AN OPEN UNIT (FOR ODT).
C
C INPUT:
C I=-1 IF NO MODIFICATION.
C =VALUE IF MOD DESIRED.
C M=NOT USED.
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)
IF(BW.EQ.0) RETURN
TMP =TIME
IF(I.LT.0)GO TO 2
C MODIFY A BYTE, WORD
C OR REGISTER.
IF(BW.GE.3.AND.BW.LE.6)GOTO 1
IF(BW.EQ.1)CALL SME(CAD,I,J)
IF(BW.EQ.2)CALL SMW(CAD,I,J)
IF(BW.EQ.7)CALL PREG(CAD,I)
2 BW=0
TIME=TMP
ADSTFL=0
RETURN
C MODIFY A CONDITION CODE.
1 IF(BW.EQ.3)CALL SC(I)
IF(BW.EQ.4)CALL SN(I)
IF(BW.EQ.5)CALL SZ(I)
IF(BW.EQ.6)CALL SV(I)
GO TO 2
END
SUBROUTINE NRMSET
C SET CONDITION CODES FROM
C RESULT,CAR,OVR.
C
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
COMMON/GEN5/STDEST
C STDEST IS SET IF INSTRUCTION TRIED TO MODIFY
C STATUS WORD.
IF(STDEST.NE.0) RETURN
I=RESULT
CALL SC(CAR)
CALL SV(OVR)
J=C2T15
IF(SG.NE.0)J=C2T7
CALL LAND(I,J)
CALL SN(I)
CALL SZ(0)
J=MAL
IF(SG.NE.0)J=ML
CALL LAND(RESULT,J)
IF(RESULT.EQ.0)CALL SZ(1)
RETURN
END
SUBROUTINE MEMLEG(A,E,F)
C TEST FOR ADDRESS LEGALITY AND CLASS
C THE ADDRESS.
C
C INPUT:
C A=ADDRESS
C OUTPUT:
C E=0-OK
C =1-ILLEGAL
C =2,3,4-ADDRESS STOP ON READ,
C WRITE OR EITHER.
C
C
C F=0-MAIN MEM. R/W
C =1-ROM
C =2-EXT. PAGE
C =3-NOT ASSIGNED.
IMPLICIT INTEGER(A-Z)
COMMON/MEM/MEM(4096),MEMROL,MEMROH,ROMF,MEMH ,MEMLIM
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
E=0
F=0
IF(A.GE.0)GO TO 1
2 E=1
RETURN
1 IF(A.GE.SCRBEG.AND. A.LE.SCREND)GO TO 3
IF(A.EQ.XTCHAD.OR.A.EQ.XTCHAD+1)GOTO 3
IF(A.EQ.ACC.OR.A.EQ.ACC+1)GOTO 3
IF(A.GE.MEMH)GO TO 2
5 IF(ADSTCL.EQ.0)GOTO 6
IF(ADSTOP.NE.A)GO TO 6
E=ADSTCL+1
6 IF(ROMF.EQ.0)RETURN
IF(A.GE.MEMROL.AND.A.LE.MEMROH)F=1
RETURN
3 F=2
GOTO 5
4 F=3
GOTO 5
END
SUBROUTINE DEVFIL(K,LA,LB)
C READ COMMAND OF FORM DEV:FILE/X
C TERMINATED BY <CR> OR COMMA.
C
C OUTPUTS:
C K=0-NO ERROR, DATA SEEN.
C =1-^R SEEN.
C =2-ONLY <CR> SEEN.
C =3-ERROR.
C LA=0-<CR> TERMINATOR; 1-COMMA TERMINATOR.
C LB=SWITCH CHARACTER (AFTER SLASH).
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
COMMON/CNTRLR/CNTRLR
COMMON/CHAR/LEGALF,NUM,COMMND,COMMNN,SHIFT,CNTRLU,RUBOUT,
1 ALTMD1,ALTMD2,ALTMD3,DOLLFT,BLANKL ,LEGALN,NUMN,TABLFT,ICHAR,
2 COLON,SLASH
DIMENSION LEGALF(4),NUM(2),COMMND(40,2)
EQUIVALENCE (CRLEFT,COMMND(25,1)),(ARO,COMMND(27,1)),
1 (BARO,COMMND(26,1)),(LFLEFT,COMMND(29,1)),(BLF,COMMND(28,1))
1 F2=0
F4=0
F5=0
LB=0
CALL SETB(DEV,1,5)
CALL SETB(FIL,1,4)
I=0
J=0
K=0
C READ A CHAR. LEFT JUSTIFY. TEST FOR SPECIAL CHARS.
2 CALL CRCS(C)
CALL BTX (T1,0,CHRLEN-1,C)
C=T1
CALL CAM(L,C,1,CNTRLU,1,1)
IF(L.EQ.0)GO TO 3
CALL CAM(L,C,1,RUBOUT,1,1)
IF(L.EQ.0)GO TO 3
CALL CAM(L,C,1,CNTRLR,1,1)
IF(L.EQ.0)GO TO 4
CALL CAM(L,C,1,BLANK,1,1)
IF(L.EQ.0)GO TO 2
CALL CAM(L,C,1,CRLEFT,1,1)
IF(L.EQ.0)GO TO 5
CALL CAM(L,C,1,COMMA,1,1)
IF(L.EQ.0)GO TO 6
CALL CAM(L,C,1,COLON,1,1)
IF(L.EQ.0)GO TO 7
CALL CAM(L,C,1,SLASH,1,1)
IF(L.EQ.0)GO TO 15
C NO SPECIAL CHAR. ACCUMULATE INTO FIL OR DEV.
IF(F2.EQ.0)GO TO 8
J=J+1
CALL MOVE(FIL,J,C,1,1)
IF(J.LE.4)GO TO 2
J=3
9 F5=1
GO TO 2
8 I=I+1
CALL MOVE(DEV,I,C,1,1)
IF(I.LE.5)GO TO 2
I=4
GO TO 9
3 CALL LIST(BLANK,1,1,3)
GO TO 1
4 K=1
CALL LIST(BLANK,1,1,3)
RETURN
C <CR> SEEN.
5 F4=1
IF(F2.EQ.0)K=2
10 IF(F5.NE.0)K=3
C GOBBLE <LF> AFTER <CR>.
IF(F4.NE.0)CALL CRCS(C)
LA=F4
RETURN
C COMMA SEEN.
6 F4=0
IF(F2.EQ.0)F5=1
GO TO 10
C COLON SEEN.
7 IF(I.EQ.0)GO TO 9
F2=1
I=0
GO TO 2
C SLASH SEEN. GET SWITCH CHARACTER.
15 CALL CRCS(T1)
CALL BTX(LB,0,CHRLEN-1,T1)
GO TO 2
END