! DISC UTILITY AND TEST PROGRAM
!W.S.C. 16TH AUGUST 1976
!LAST UPDATED 31/8/76 10:40
!THE FOLLOWING TEST STATES CAN BE SELECTED
! 1-READ N BLOCKS AND LIST THEM
! 2-WRITE N BLOCKS WITH A GIVEN PATTERN
! 3-COMPARE N BLOCKS WITH A GIVEN PATTERN
! 4-BLOCK PATCHING FACILITY
! 5-FORMAT STATUS ALTERATION
!THE PROGRAM REQUESTS THE TEST NUMBER THEN ASKS FOR
!DATA AS REQUIRED.AT THE END OF EACH TEST THE USER CAN SELECT
!ANOTHER TEST.TEST 0 TERMINATES THE PROGRAM.
CONTROL K'101011'
PERMROUTINESPEC SVC(INTEGER EP,P1,P2)
BEGIN
RECORDFORMAT PF(BYTEINTEGER SERVICE,REPLY,INTEGER A1,C
INTEGERARRAYNAME A2,INTEGER A3)
RECORD (PF) P
CONSTBYTEINTEGERNAME ID=K'160030'
CONSTBYTEINTEGERARRAY DKID(0:4)=3,3,8,14,28
INTEGER LOOP,TEST,STBLK,NBLKS,REP,I,UNIT,J,PATT,ERRCT,RECERR
SWITCH SW(0:5)
INTEGERARRAY DBLK1(0:255)
INTEGERARRAY DBLK2(0:255); !FOR FORMAT
ROUTINE OCTRD(INTEGERNAME Z)
INTEGER Y
Z=0
WHILE NEXTSYMBOL=' ' THEN SKIPSYMBOL
LOOP:READSYMBOL(Y)
Y=Y-'0'
IF 0>Y OR Y>7 THEN Y=0
Z=(Z<<3)!Y
IF NEXTSYMBOL#NL THEN ->LOOP
SKIPSYMBOL
END
ROUTINE DISCGO(INTEGER BLOCK,DISC,INTEGERARRAYNAME ADD,C
INTEGER MODE)
RECERR=0
IF MODE&1=0 START ; !READS
CYCLE J=0,1,255
ADD(J)=0
REPEAT
FINISH
P_SERVICE=DKID(DISC)
P_REPLY=ID
P_A3=BLOCK
IF DISC=1 THEN P_A3=P_A3!K'020000'; !RK05 UNIT 1
P_A2==ADD
P_A1=MODE
PONOFF(P)
WHILE P_A1#0 CYCLE ; !ERROR
IF P_A1>=10 START
RECERR=1; !RECOVERABLE ERROR(BAD SECTOR)
EXIT
FINISH
PRINTSTRING('HANDLER ERROR ')
WRITE(P_A1,2)
NEWLINE;CYCLE ;REPEAT
REPEAT
END
ROUTINE BLK
PROMPT('DISC=')
READ(UNIT)
PROMPT('START BLOCK(OCTAL)=')
OCTRD(STBLK)
PROMPT('NUMBER OF BLOCKS(OCTAL)=')
OCTRD(NBLKS)
PROMPT('LOOP?')
WHILE NEXTSYMBOL<'A' OR NEXTSYMBOL>'Z' THEN SKIPSYMBOL
READSYMBOL(LOOP);SKIPSYMBOL
END
ROUTINE CHARP(INTEGER X)
IF X<K'40' OR X>K'176' THEN PRINTSYMBOL('*') C
ELSE PRINTSYMBOL(X)
END
ROUTINE OCTWRT(INTEGER X)
INTEGER Y
CYCLE Y=15,-3,0
PRINTSYMBOL((X>>Y)&7+'0')
REPEAT
END
ROUTINE BYTWRT(INTEGER X,B)
INTEGER Y,Z,S,F
IF B=0 START
Z=X&K'377';S=6;F=0
FINISHELSESTART
Z=X&K'177400'
S=15;F=9
FINISH
CYCLE Y=S,-3,F
PRINTSYMBOL((Z>>Y)&7+'0')
REPEAT
END
ROUTINE PRBLK(INTEGERARRAYNAME DBLK,INTEGER N)
INTEGER K,J
SELECT OUTPUT(1)
PRINTSYMBOL(12)
NEWLINES(2)
PRINTSTRING('UNIT ')
WRITE(UNIT,1)
PRINTSTRING(' BLOCK ')
OCTWRT(STBLK+I)
NEWLINES(2)
CYCLE K=0,1,(N//8)-1
BYTWRT(K*8,0);PRINTSYMBOL('>')
CYCLE J=0,1,7
OCTWRT(DBLK((K*8)+J))
SPACE
REPEAT
SPACE
CYCLE J=0,1,7
CHARP(DBLK((K*8)+J)&K'377')
CHARP((DBLK((K*8)+J)&K'177400')>>8)
REPEAT
NEWLINE
REPEAT
SELECT OUTPUT(0)
END
!*********************************************************
SVC(13,24,0)
PRMPT:
PROMPT('TEST NUMBER=')
READ(TEST)
->SW(TEST)
!*************************************************************
SW(0):
!END OF PROGRAM REQUEST
STOP
!**************************************************************
SW(1):
!READ N BLOCKS AND LIST THEM.
BLK
PROMPT('LIST?')
WHILE NEXTSYMBOL<'A' OR NEXTSYMBOL>'Z' THEN SKIPSYMBOL
READSYMBOL(REP)
SKIPSYMBOL
L1:CYCLE I=0,1,NBLKS-1
DISCGO(STBLK+I,UNIT,DBLK1,0)
IF RECERR=0 START
IF REP='Y' THEN PRBLK(DBLK1,256)
FINISH
REPEAT
IF LOOP='Y' THEN ->L1
OKOUT:
NEWLINE
PRINTSTRING('TEST COMPLETED')
NEWLINE
->PRMPT
!*************************************************************
SW(2):
!WRITE N BLOCKS WITH PATTERN.
BLK
PROMPT('OCTAL PATTERN=')
OCTRD(PATT)
CYCLE I=0,1,255
DBLK1(I)=PATT
REPEAT
L2:CYCLE I=0,1,NBLKS-1
DISCGO(STBLK+I,UNIT,DBLK1,1)
REPEAT
IF LOOP='Y' THEN ->L2
->OKOUT
!************************************************************
SW(3):
!COMPARE N BLOCKS WITH PATTERN.
BLK
ERRCT=0
PROMPT('OCTAL PATTERN=')
OCTRD(PATT)
L3:CYCLE I=0,1,NBLKS-1
DISCGO(STBLK+I,UNIT,DBLK1,0)
IF RECERR=0 START
CYCLE J=0,1,255
IF DBLK1(J)#PATT START
ERRCT=ERRCT+1
PRINTSTRING('COMPARE ERROR ')
PRINTSTRING('BLK ')
OCTWRT(STBLK+I);SPACE
OCTWRT(PATT)
PRINTSTRING(' IS ')
OCTWRT(DBLK1(J))
PRINTSTRING(' AT ')
OCTWRT(J)
NEWLINE
IF ERRCT=3 START ; !INLY 3 ERRORS PER BLOCK REPORTED
ERRCT=0
EXIT
FINISH
FINISH
REPEAT
FINISH
REPEAT
IF LOOP='Y' THEN ->L3
->OKOUT
!**************************************************************
SW(4):
!PATCH DISC BLOCK.
BLK
DISCGO(STBLK,UNIT,DBLK1,0)
IF RECERR#0 START
PRINTSTRING('BAD SECTOR-CANNOT PATCH')
NEWLINE
->OKOUT
FINISH
WDOFF:PROMPT('WORD OFFSET=')
OCTRD(NBLKS)
IF NBLKS>255 THEN ->CHECK
OCTWRT(DBLK1(NBLKS)); !PRINT OLD
NEWLINE
OCTRD(DBLK1(NBLKS)); !GET NEW
->WDOFF
CHECK:PROMPT('NEW BLOCK LIST?')
WHILE NEXTSYMBOL<'A' OR NEXTSYMBOL>'Z' THEN SKIPSYMBOL
READSYMBOL(REP);SKIPSYMBOL
IF REP='Y' THEN PRBLK(DBLK1,256)
PROMPT('ARE YOU SURE??')
WHILE NEXTSYMBOL<'A' OR NEXTSYMBOL>'Z' THEN SKIPSYMBOL
READSYMBOL(REP);SKIPSYMBOL
IF REP ='Y' START
DISCGO(STBLK,UNIT,DBLK1,1)
->OKOUT
FINISH
PROMPT('MORE CHANGES?')
READSYMBOL(REP);SKIPSYMBOL
IF REP='Y' THEN ->WDOFF ELSE ->OKOUT
!**************************************************************
SW(5):
!READ AND ALTER FORMAT STATUS OF BLOCK
BLK
PRINTSTRING('ENSURE FORMAT ENABLE SWITCH IS ON')
NEWLINE
PRINTSTRING('ENSURE WRITE PROTECT OVERRIDE SWICH IS ON')
NEWLINE
DISCGO(STBLK,UNIT,DBLK2,2)
OCTWRT(DBLK2(0));SPACE; !ADDR/STAT 1
OCTWRT(DBLK2(1));SPACE; !ADDR/STAT 2
NEWLINE
ALT:
PROMPT('ALTER STATUS?')
WHILE NEXTSYMBOL<'A' OR NEXTSYMBOL>'Z' THEN SKIPSYMBOL
READSYMBOL(REP);SKIPSYMBOL
IF REP='N' THEN ->OKOUT
PROMPT('NEW STATUS(OCTAL)=')
OCTRD(PATT)
IF PATT&K'1777'#DBLK2(0)&K'1777' START
PRINTSTRING('STATUS ERROR!')
NEWLINE
->ALT
FINISH
PROMPT('ARE YOU SURE?')
WHILE NEXTSYMBOL<'A' OR NEXTSYMBOL>'Z' THEN SKIPSYMBOL
READSYMBOL(REP);SKIPSYMBOL
IF REP#'Y' THEN ->ALT
CYCLE I=0,1,NBLKS-1
DISCGO(STBLK+I,UNIT,DBLK1,0); !SAVE DATA
DISCGO(STBLK+I,UNIT,DBLK2,2); !GET FORMAT STATUS
DBLK2(0)=(DBLK2(0)&K'1777')!(PATT&K'1777')
DISCGO(STBLK,UNIT,DBLK2,3)
IF DBLK2(0)&K'40000'=0 THEN DISCGO(STBLK,UNIT,DBLK1,1); !RESTORE DATA
REPEAT
->OKOUT
ENDOFPROGRAM