Google
 

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