PERMROUTINESPEC SVC(INTEGER EP, INTEGERNAME R0, R1)
PERMINTEGERMAPSPEC INTEGER(INTEGER N)
PERMBYTEINTEGERMAPSPEC BYTEINTEGER(INTEGER N)
PERMINTEGERFNSPEC ADDR(INTEGERNAME N)
PERMINTEGERFNSPEC ACC
OWNINTEGERNAME DUMMY = 0
CONTROL K'100101'
BEGIN
ROUTINESPEC DA(INTEGER MODE, BLOCK, INTEGERNAME ADR)
INTEGERFNSPEC SET BIT(INTEGER BLOCK)
ROUTINESPEC OCTAL(INTEGER N)
!!
RECORDFORMAT BF(INTEGER PR, NEXT)
RECORD (BF) ARRAY BA(0:K'177')
RECORD (BF) NAME BL,BL2
RECORD (BF) MAPSPEC GET POS(INTEGER N)
!!
RECORDFORMAT FF(BYTEINTEGERARRAY NAME(0:5), INTEGER FIRST,PR)
RECORD (FF) ARRAY FA(0:52)
RECORD (FF) NAME FI
RECORDFORMAT F2F(INTEGER X)
RECORD (F2F) NAME F2
!!:
INTEGER I, J, N, DEVICE, BLOCK, TOT, SV2, USER, F, L, FREE, C
INTEGER PR, CN, B, SV, PT, BLSTA, LIST, P, FLAG, CORRUPT
OWNINTEGER DRIVE = 0; ! UNIT ZERO
OWNINTEGER DIRB=K'150'
OWNINTEGER DIRE=K'247'
OWNINTEGER TOP=4800
CONSTINTEGER RDISC=0
CONSTINTEGER WDISC=1
INTEGERARRAY BLALL(0:300)
!!
F2==FA(0)
ANN:
PROMPT('LIST?')
READSYMBOL(LIST)
IF LIST='0' OR LIST='1' START
IF LIST='1' THEN DRIVE=K'020000'
READSYMBOL(LIST); IF LIST#'.' THENSTOP
READSYMBOL(LIST)
FINISH
!! DIRB=COM(-1); ! PICK UP DIR AREA
DIRE=DIRB+K'100'
!! TOP=COM(-2); ! NUMBER OF BLOCKS
TOP=K'11277'
SKIPSYMBOL
IF LIST#'N' AND LIST#'Y' AND LIST#'F' AND LIST#'P' START
PRINTSTRING( '?
')
->ANN
FINISH
IF LIST#'N' THEN SELECT OUTPUT(1)
F=10000; L=0; FREE=0
CYCLE I=0, 1, 300; BLALL(I)=0; REPEAT
USER=0
IF LIST#'N' START
PRINTSYMBOL(12); ! NEWPAGE
PRINTSTRING( '
NAME FIRST LAST CODE SIZE
')
FINISH
CYCLE BLOCK=DIRB, 1, DIRE
DA(RDISC, BLOCK, F2_X)
FLAG=0; ! 'USER' PRINTED FLAG
TOT=0
CYCLE I=0, 1, 52
FI==FA(I)
IF FI_NAME(0)#0 START ; ! FILE HERE
CN=0; CORRUPT=0
B=FI_FIRST; SV=B
C=0
UNTIL B=0 CYCLE
IF LIST='F' START
OCTAL(B)
IF C#7 THEN C=C+1 ELSESTART
C=0; NEWLINE
FINISH
FINISH
IF B>TOP OR B<0 START
PRINTSTRING( 'NON EXISTANT BLOCK:')
OCTAL(B); B=0; NEWLINE
FINISHELSESTART
BL==GET POS(B)
IF BL_PR#FI_PR START
IF LIST='N' OR (CORRUPT>2 AND LIST#'F') C
START
CORRUPT=CORRUPT+1
FINISHELSESTART
PRINTSTRING( 'BLOCK:'); OCTAL(B)
PRINTSTRING( ' E:'); OCTAL(FI_PR)
PRINTSTRING( ' A:'); OCTAL(BL_PR)
PRINTSTRING( ' CODE ERROR
')
FINISH
FINISH
SV2=B
B=BL_NEXT
CN=CN+1; TOT=TOT+1
IF SV2<F THEN F=SV2
IF SV2>L THEN L=SV2
J=SET BIT(SV2)
FINISH
REPEAT
IF LIST#'N' OR CORRUPT#0 START
IF C#0 THEN NEWLINE
IF FLAG=0 START
PRINTSTRING( '
USER')
PRINTSYMBOL(USER>>3+'0')
PRINTSYMBOL(USER&X'7'+'0'); NEWLINE
FLAG=FLAG+1
FINISH
CYCLE J=0, 1, 5
PRINTSYMBOL(FI_NAME(J))
REPEAT
SPACES(2); OCTAL(SV)
OCTAL(SV2); OCTAL(FI_PR); OCTAL(CN)
IF CORRUPT#0 START
PRINTSTRING( ' THIS FILE HAS'); WRITE(CORRUPT, 1)
PRINTSTRING( ' CORRUPTED BLOCKS')
FINISH
NEWLINE
FINISH
FINISH
REPEAT
IF LIST#'N' AND FLAG#0 START
PRINTSTRING( 'NO OF BLOCKS ='); WRITE(TOT, 1); NEWLINE
FINISH
USER=USER+1
REPEAT
CYCLE I=K'400', 1, TOP
N=SET BIT(I); BL==GET POS(I)
P=BL_PR
IF P=0 THEN FREE=FREE+1
IF N=0 AND P#0 START
PRINTSTRING( 'BLOCK:')
OCTAL(I); PRINTSTRING( ' P'); OCTAL(P)
PRINTSTRING( ' N'); OCTAL(BL_NEXT)
PRINTSTRING( ' LOST')
IF LIST='P' START ; ! PATCH DISC
BL=0
BL2==GET POS(-1); ! WRITE BACK
PRINTSTRING( ' NOW RECOVERED')
FINISH
NEWLINE
FINISH
IF N#0 AND P=0 START
PRINTSTRING( 'BLOCK:'); OCTAL(I)
PRINTSTRING( ' FREE')
IF LIST='P' START ; ! PATCH DISC
BL_PR=TOP+1; ! UN-FREE IT
BL2==GET POS(-1); ! WRITE IT BACK TO DISC
PRINTSTRING( C
' NOW REMOVED FROM FREE LIST - BUT STILL DANGEROUS')
FINISH
PRINTSTRING( ' *** TIDY IT ***
')
FINISH
REPEAT
NEWLINES(2)
SELECT OUTPUT(1)
PRINTSTRING( 'FIRST:'); OCTAL(F)
PRINTSTRING( '
LAST: '); OCTAL(L)
PRINTSTRING( '
TOP: '); OCTAL(I)
PRINTSTRING( '
FREE: '); OCTAL(FREE-F); WRITE(FREE-F, 4)
NEWLINE
!! NEWPAGE
NEWLINE
SELECT OUTPUT(0)
PRINTSTRING( 'FINISHED
')
!!
!!
INTEGERFN SET BIT(INTEGER BLOCK)
INTEGER I, J, K
CONSTINTEGERARRAY BIT POS(0:15)= C
X'0001', X'0002', X'0004', X'0008',
X'0010', X'0020', X'0040', X'0080',
X'0100', X'0200', X'0400', X'0800',
X'1000', X'2000', X'4000', X'8000'
I=BLOCK>>4
J=BLOCK&15
K=BLALL(I)&BITPOS(J)
BLALL(I)=BLALL(I)!BIT POS(J)
RESULT =K
END
!!
RECORD (BF) MAP GET POS(INTEGER N)
OWNINTEGER SAVE=0
INTEGER I
IF N=-1 START ; ! WRITE BACK TO DISC
DA(WDISC, SAVE, BA(0)_PR)
SAVE=0
FINISH
I=K'100'+N>>7
IF I#SAVE THEN DA(RDISC, I, BA(0)_PR)
SAVE=I
RESULT ==BA(N&K'177')
END
ROUTINE OCTAL(INTEGER N)
INTEGER I
SPACE
CYCLE I=15, -3, 0
PRINTSYMBOL((N>>I)&7+'0')
REPEAT
END
ROUTINE DA(INTEGER MODE, BLOCK, INTEGERNAME ADDRESS)
CONSTBYTEINTEGERNAME ID=K'160030'
RECORDFORMAT PF(BYTEINTEGER SERVICE, REPLY, C
INTEGER A1, INTEGERNAME A2, INTEGER A3)
RECORD (PF) P
P_SERVICE=3; P_REPLY=ID
P_A1=MODE; ! READ OR WRITE
P_A2==ADDRESS; P_A3=BLOCK!DRIVE; ! NORE: DRIVE BITS ADDED !!!!
PONOFF(P)
IF P_A1#0 START
PRINTSTRING('DISC FAULT
')
STOP
FINISH
END
!!
ENDOFPROGRAM