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