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 , C DIFFERENTIATE BETWEEN N1 AND N1,N2. 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 , GOBBLE UP . 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 OR COMMA. C C OUTPUTS: C K=0-NO ERROR, DATA SEEN. C =1-^R SEEN. C =2-ONLY SEEN. C =3-ERROR. C LA=0- 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 SEEN. 5 F4=1 IF(F2.EQ.0)K=2 10 IF(F5.NE.0)K=3 C GOBBLE AFTER . 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