FTN4,L PROGRAM TXMV0(3,89),91711-16015 REV 1926 790418 C C DISC MEMORY VERIFICATION PROGRAM. C C C GET INPUT PARAMETERS FROM RUN COMMAND C C RU,TXMV0,LIST,TESTLU C C WHERE LIST = LOGICAL UNIT FOR LISTING DEVICE. C DEFAULT IS TERMINAL CONSOLE (LU=1). C TESTLU = DISC LU TO BE TESTED C C C TEST SYSTEM DISC LOGICAL UNIT. C C TEST SEQUENCE IS: C 1. CREATE A FILE (TXM0X) ON THE LU. TYPE 1 FILE. C 2. IF AN ERROR OCCURS, THE FILE MAY HAVE ALREADY C EXISTED. THIS IS AN ERROR CONDITION. PROGRAM C REPORTS ERROR AND STOPS. C 3. OPEN THE FILE. (FILE IS AUTOMATICALLY REWOUND ON OPEN) C 4. WRITE 3 RECORDS TO THE FILE. C 5. READ THE DATA FROM THE FILE AND VERIFY EACH RECORD. C 6. REPORT ALL ERRORS ON LISTING LU. C 7. CLOSE THE FILE AND PURGE FILE. C C INTEGER PNAME(3) INTEGER NAME(3),IDCB(144),IERR,ISIZE(2),ITYPE INTEGER ICR,IPARMS(5),LULIST,LUDISC INTEGER ITEMP,CODE12 INTEGER NUMREC,IBUF(128,3),TBUF(128),NWORDS INTEGER ISTAT(125) INTEGER NERROR INTEGER CODE13 INTEGER I,J,L,LU,OFLAG INTEGER EQT4,EQT5,EQTST INTEGER NDTYPE C ERROR STATUS WORD DISC EQUIPMENT TYPES 031B AND 032B INTEGER M31LEN(8),M32LEN(8) INTEGER M31STR(8),M32STR(8) INTEGER M(125) C C DATA PNAME/2HTX,2HMV,2H0 / DATA NAME/2HTX,2HM0,2HX / DATA ISTAT/125*0/ DATA NERROR/0/ DATA ISIZE/3,128/ DATA ITYPE/1/ DATA IPARMS/5*0/ DATA CODE13/13/ DATA LULIST/1/ DATA IBUF/128*05252B,128*17777B,128*012525B/ DATA LUDISC/0/ DATA M( 1),M( 2),M( 3),M( 4),M( 5)/2HPR,2HOT,2HEC,2HT ,2HSW/ DATA M( 6),M( 7),M( 8),M( 9),M(10)/2HIT,2HCH,2H S,2HET,2H / DATA M(11),M(12),M(13),M(14),M(15)/2HDR,2HIV,2HE ,2HFO,2HRM/ DATA M(16),M(17),M(18),M(19),M(20)/2HAT,2H S,2HWI,2HTC,2HH / DATA M(21),M(22)/2HSE,2HT / DATA M(23),M(24),M(25),M(26),M(27)/2HHA,2HRD,2HWA,2HRE,2H F/ DATA M(28),M(29),M(30)/2HAU,2HLT,2H / DATA M(31),M(32),M(33),M(34),M(35)/2HFL,2HAG,2HGE,2HD ,2HTR/ DATA M(36),M(37),M(38),M(39),M(40)/2HAC,2HK(,2HPR,2HOT,2HEC/ DATA M(41),M(42),M(43)/2HTE,2HD),2H / DATA M(44),M(45),M(46),M(47),M(48)/2HSE,2HEK,2H C,2HHE,2HCK/ DATA M(49)/2H / DATA M(50),M(51),M(52),M(53),M(54)/2HNO,2HT ,2HRE,2HAD,2HY / DATA M(55),M(56),M(57),M(58),M(59)/2HDE,2HVI,2HCE,2H B,2HUS/ DATA M(60)/2HY / DATA M(61),M(62),M(63),M(64),M(65)/2HER,2HRO,2HR ,2HEX,2HIS/ DATA M(66),M(67)/2HTS,2H / DATA M(68),M(69),M(70),M(71),M(72)/2HEN,2HD ,2HOF,2H T,2HAP/ DATA M(73)/2HE / DATA M(74),M(75),M(76),M(77),M(78)/2HAD,2HDR,2HES,2HS ,2HER/ DATA M(79),M(80),M(81)/2HRO,2HR ,2H / DATA M(82),M(83),M(84),M(85),M(86)/2HDA,2HTA,2H E,2HRR,2HOR/ DATA M(87)/2H / DATA M(88),M(89),M(90),M(91),M(92)/2HUN,2HDE,2HFI,2HNE,2HD / DATA M(93),M(94),M(95),M(96),M(97)/2H S,2HTA,2HTU,2HS ,2HBI/ DATA M(98)/2HT / DATA M(99),M(100),M(101),M(102)/2HDI,2HSC,2H H,2HAR/ DATA M(103),M(104),M(105),M(106)/2HDW,2HAR,2HE ,2HER/ DATA M(107),M(108),M(109),M(110)/2HRO,2HR ,2H ,2H / DATA M31LEN/10,12,10,10,10,05,06,07/ DATA M31STR/01,11,99,99,99,50,55,61/ DATA M32LEN/11,05,06,10,10,10,10,07/ DATA M32STR/88,50,68,99,99,99,99,61/ C C C GET INPUT PARAMETER FOR LISTING LOGICAL UNIT CALL RMPAR(IPARMS) LULIST=IPARMS(1) IF (IPARMS(1).LE.0) LULIST=LOGLU(IPARMS(1)) LUDISC = IPARMS(2) IF ((LUDISC.GT.0).AND.(LUDISC.LT.64)) GO TO 700 C INVALUD LU NUMBER SPECIFIED WRITE(LULIST,9795) (PNAME(J),J=1,3) 9795 FORMAT(/,2X,3A2,"- LU# SPECIFIED FOR DISC IS ILLEGAL."/ 1" RERUN TEST SPECIFYING AN INTEGER >0 AND <64 FOR LU#.") GO TO 850 700 CONTINUE C C MAIN PROGRAM LOOP C C TEST ALL POSSIBLE LU'S ON SYSTEM LU = -LUDISC C TEST TO SEE IF LU IS ASSIGNED TO A KNOWN DISC TYPE. CALL EXEC(CODE13,LUDISC,EQT5,EQT4,EQTST) C C IF CHANNEL NUMBER = 0, THIS LU IS NOT ASSIGNED TO ANY DEVICE IF (IAND(EQT4,077B).NE.0) GO TO 800 C C LU IS UNASSIGNED. DO NOT TEST THIS LU. WRITE(LULIST,5007) (PNAME(J),J=1,3),LUDISC 5007 FORMAT(/,2X,3A2,"- LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GO TO 9999 C MAKE SURE DEVICE IS ASSIGNED TO A DISC DEVICE. 800 NDTYPE = IAND(EQT5,037400B) NDTYPE = NDTYPE / 0400B IF ((NDTYPE.GE.031B).AND.(NDTYPE.LE.033B)) GO TO 900 C LU NOT ASSIGNED TO A KNOWN DISC TYPE. WRITE(LULIST,5004) (PNAME(J),J=1,3),LUDISC 5004 FORMAT(/,2X,3A2,"- LU#",I3," IS NOT ASSIGNED TO A DISC."/ 1" RERUN TEST SPECIFYING CORRECT LU#.") GO TO 850 900 CONTINUE C CHECK DISC STATUS TO VERIFY THAT DISC CAN BE TESTED. C IS DISC ONLINE? CALL EXEC(CODE13,LUDISC,EQT5,EQT4,EQTST) IF (IAND(EQTST,0100000B).EQ.0) GO TO 925 C C DISC LU IS DOWN C WRITE(LULIST,5102) (PNAME(J),J=1,3),LUDISC GO TO 850 C C DISC LU IS UP. CHECK TO SEE IF CARTRIDGE IS MOUNTED. GET C STATUS OF CARTRIDGES MOUNTED. C 925 CALL FSTAT(ISTAT) DO 930 J=1,125,4 IF (LUDISC.EQ.ISTAT(J)) GO TO 940 IF (ISTAT(J).EQ.0) GO TO 932 930 CONTINUE C C CARTRIDGE IS NOT MOUNTED C 932 WRITE(LULIST,9321) (PNAME(J),J=1,3),LUDISC 9321 FORMAT(/,2X,3A2,"- LU#",I3,": CARTRIDGE NOT MOUNTED."/ 1" MOUNT CARTRIDGE AND RERUN TEST.") C C WRITE ABORT MESSAGE C 850 CONTINUE WRITE(LULIST,8501) (PNAME(J),J=1,3),LUDISC 8501 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST ABORTED!"/) GO TO 9999 C C START DISC TEST. ALL OPERATIONAL CHECKS HAVE BEEN MADE C 940 CONTINUE WRITE(LULIST,9501) (PNAME(J),J=1,3),LUDISC 9501 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST RUNNING") C TRY CREATING THE TEST FILE TXM0X ON THE DISC. IF AN ERROR C IS RETURNED THEN THE FILE PROBABLY ALREADY EXISTS. TEST C ERROR CODE. IF NOT AN ERROR FOR FILE PREVIOUSLY DEFINED, C THEN PRINT ERROR MESSAGE. C C INITIALIZE FLAG FOR FILE NOT OPENED YET. OFLAG = 0 CALL CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,0,LU) C CREATE OPENS FILE FOR EXCLUSIVE ACCESS. C IERR > 0 NO ERROR. EQUALS SIZE OF FILE ALLOCATED. IF (IERR.NE.-6) GO TO 950 C ERROR = -6. CARTRIDGE NOT FOUND OR NO ROOM. C PROBABLE CAUSE IS CARTRIDGE NO MOUNTED OR CARTRIDGE FULL. WRITE(LULIST,5005) (PNAME(J),J=1,3),LUDISC 5005 FORMAT(/,2X,3A2,"- LU#",I3,": NO ROOM ON DISC FOR TEST FILE.") NERROR = NERROR + 1 GO TO 8000 950 CONTINUE IF (IERR.GT.0) GO TO 1000 IF (IERR.EQ.-2) GO TO 5060 IF (IERR.NE.-2) GO TO 5000 C IERR = -2 FOR FILE ALREADY EXISTS. OPEN THE FILE FOR C EXCLUSIVE ACCESS. CALL OPEN(IDCB,IERR,NAME,0,0,LU) IF (IERR.LT.0) GO TO 5010 C VERIFY FILE TYPE = 1 IF (IERR.NE.1) GO TO 5020 C THIS IS THE CORRECT TEST FILE. OPEN CALLS AUTOMATICALLY C REWIND THE FILE. WRITE, READ, AND VERIFY THREE RECORDS C (384 WORDS) 1000 CONTINUE C SET OPEN FLAG FOR FILE OPENED. OFLAG = 1 CALL WRITF(IDCB,IERR,IBUF,384,1) IF (IERR.LT.0) GO TO 5050 DO 1500 J=1,3 CALL READF(IDCB,IERR,TBUF,128,NWORDS,J) IF (IERR.NE.0) GO TO 5030 DO 1200 L=1,128 IF (TBUF(L).EQ.IBUF(L,J)) GO TO 1200 C DATA VERIFICATION ERROR WRITE(LULIST,5135) (PNAME(K),K=1,3),LUDISC,(NAME(K),K=1,3) 5135 FORMAT(/,2X,3A2,"- LU#",I2,": READ/WRITE DATA DOES NOT VERIFY" 1" ON FILE ",3A2) IF (NERROR.GE.6) GO TO 8000 1200 CONTINUE 1500 CONTINUE C C DATA VERIFIES. CLOSE FILE. CALL CLOSE(IDCB,IERR) IF (IERR.LT.0) GO TO 5040 C TEST COMPLETED SUCCESSFULLY. WRITE MESSAGE TO LISTING CALL PURGE(IDCB,IERR,NAME,0,LU) IF (IERR.LT.0) GO TO 5070 GO TO 8000 C C ERROR PATHS C 5000 WRITE(LULIST,5100) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5100 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR CREATING FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5010 WRITE(LULIST,5110) (PNAME(J),J=1,3), LUDISC,(NAME(J),J=1,3), 1 IERR 5110 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR OPENING FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5020 WRITE(LULIST,5120) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5120 FORMAT(/,2X,3A2,"- LU#",I3,": CREATED FILE ",3A2," IS WRONG" 1"TYPE. TYPE=",I4) GO TO 5500 5030 WRITE(LULIST,5130) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5130 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR READING FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5040 WRITE(LULIST,5140) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5140 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR CLOSING FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5050 WRITE(LULIST,5150) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5150 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR WRITING FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5060 WRITE(LULIST,5160) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5160 FORMAT(/,2X,3A2,"- LU#",I3,": DUPLICATE FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5070 WRITE(LULIST,5170) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5170 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR PURGING FILE ",3A2,". " 1 "ERROR=",I4) C C GET ERROR STATUS FROM DEVICE C 5500 CONTINUE NERROR = NERROR + 1 C GET DEVICE STATUS (I/O STATUS CALL) CALL EXEC(CODE13,LUDISC,EQT5,EQT4,EQTST) C CHECK LOGICAL UNIT DECLARED DOWN IF (EQTST.LT.0) GO TO 5750 C PRINT ERROR STATUS DEPENDING UPON DISC TYPE. EQT5 = EQT5/2 DO 5575 K=7,1,-1 IF (IAND(EQT5,1).EQ.0) GO TO 5560 IF (NDTYPE-032B) 5510,5520,5560 C DISC EQUIPMENT TYPE = 031B 5510 WRITE(LULIST,5555) (PNAME(J),J=1,3),LUDISC, 1 (M(M31STR(K)+J-1), J=1,M31LEN(K)) GO TO 5560 C DISC EQUIPMENT TYPE = 032B 5520 WRITE(LULIST,5555) (PNAME(J),J=1,3),LUDISC, 1 (M(M32STR(K)+J-1), J=1,M32LEN(K)) 5555 FORMAT(/,2X,3A2,"- LU#",I3,": ",20A2) C DISC EQUIPMENT TYPE = 033B 5560 EQT5 = EQT5/2 5575 CONTINUE C CLEANUP FOR ERROR CONDITIONS. CLOSE AND PURGE FILE. IF (OFLAG.EQ.0) GO TO 5600 CALL CLOSE(IDCB,IERR) CALL PURGE(IDCB,IERR,NAME,0,LU) 5600 GO TO 8000 5750 WRITE(LULIST,5102) (PNAME(J),J=1,3),LUDISC 5102 FORMAT(/,2X,3A2,"- LU#",I3,", EQT OR LU FOR TEST DISC" 1" IS DOWN."/" UP EQT AND RERUN TEST.") C C END OF MAIN PROGRAM LOOP C 8000 CONTINUE WRITE(LULIST,9810) (PNAME(J),J=1,3),LUDISC,NERROR 9810 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST FINISHED ",I2, 1" ERRORS"/) C C TERMINATE PROGRAM 9999 CONTINUE END END$