!************
!*  RL04S   *
!*07.OCT.80*
!************
!* UNIT 4 ADDED

%CONTROL K'100001';                    ! 'SYSTEM' PROGRAM+MUL+TRUSTED

%BEGIN
     %SYSTEMINTEGERFNSPEC GETID
     %SYSTEMROUTINESPEC LINKIN(%INTEGER SER)
     %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEGS)

     %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %INTEGER A1, A2, A3)
     %RECORDFORMAT P2F(%INTEGER D)

     %RECORDFORMAT RLF(%INTEGER CS, BA, DA, MP)
     %CONSTRECORD (RLF) %NAME RL = K'114400'
     %CONSTINTEGERNAME PS = K'117776'

     %CONSTINTEGER RLTOP = 10239
     %OWNINTEGER RL BOT = K'77'

     %CONSTINTEGER UNIT1 = K'020000'
     %CONSTINTEGER RL INT = -3;      ! ????


     %CONSTINTEGERARRAY LOOK UP(0:1) = K'114', K'112'
     !! READ (0) AND WRITE (1) COMMANDS FOR THE RK05
     %CONSTINTEGER SEEK = 6


     %RECORD (PF)P, PX
     %RECORD (P2F) %NAME P2

     %INTEGER PAR, ID, BLOCK, COMM, BL, I, DRIVE, RETRY
     %INTEGER DAR, COMM2, MID, FAULT, REPLY
     %INTEGER ACT, SECTOR, TRACK, DIFF, SURFACE, DES


      %INTEGERFN GET STATUS(%INTEGER TYPE)

          !! GETS STATUS FROM RL01 IF TYPE=1
          !!      TYPE = K'13' DOES A RESET DRIVE

         RL_DA = TYPE
         RL_CS = 4!DRIVE;             ! GET STATUS
         %WHILE RL_CS&K'200' = 0 %CYCLE; %REPEAT
         %RESULT = RL_MP
      %END

     P2 == PX
     MID = GETID
     LINKIN(3);                       ! MAIN DISC SERVICE
     LINKIN(28);                      ! UNIT 4 SER (MAPPED TO UNIT 1)
      LINKIN(RL INT);                     ! INT SERVICE
     MAPHWR(4)
     PS = PS&K'177400';              ! UNTIL SUPERVISOR CHANGED

      I = GET STATUS(K'13')
     %IF RL_CS < 0 %START
     %FINISH

     %CYCLE
        P_SERVICE = 0
        POFF(P)
        FAULT = 0
        ID = P_REPLY;  REPLY = P_SERVICE
        %IF P_A2 = 0 %START
           RL BOT = 0;  FAULT = 9
        %ELSE
           DRIVE = 0;                  ! NORMALLY DRIVE 0
           %IF REPLY = 28 %THEN DRIVE = K'400'; ! UNIT 4 -> DRIVE 1
           PAR = MAP ABS(P_A2, 512, ID)
           %IF PAR = 0 %THEN FAULT = 1 %ELSESTART
              PAR = PAR+(P_A2&K'17777') >> 6
              !! ADD IN BLOCK DISP
              COMM2 = LOOK UP(P_A1&1)
              %IF PAR >= K'2000' %START
                                       ! NEED TO SET 17&18TH BITS
                 COMM2 = COMM2!(PAR&K'6000') >> 6
                 PAR = PAR&K'1777'
              %FINISH
              DAR = 0
              BLOCK = P_A3

              %IF BLOCK < RLBOT %OR BLOCK > RLTOP %THEN FAULT = 4 %C
                %ELSESTART
                 COMM =- (P_A1 >> 1)
                 %IF COMM = 0 %THEN COMM =- 256
                 SECTOR = BLOCK
                 TRACK = 0
                 %CYCLE
                    %IF SECTOR < 20 %THENEXIT
                    TRACK = TRACK+K'100'
                    SECTOR = SECTOR-20
                 %REPEAT
                 TRACK = TRACK!(SECTOR << 1)
                 RETRY = 10
AGN:
                 %WHILE RL_CS&K'200' = 0 %CYCLE; %REPEAT
                 RL_CS = K'10'!DRIVE;  ! READ HEADERS
                 %WHILE RL_CS&K'200' = 0 %CYCLE; %REPEAT
                  %IF RL_CS < 0 %START
                     %IF GET STATUS(K'13') < 0 %THEN -> FLTR
                     -> AGN
                 %FINISH
                 ACT = RL_MP&K'177600'
                                       ! DISCARD SURFACE&SECTOR
                 DES = TRACK&K'177600'
                 SURFACE = (TRACK&K'100') >> 2
                 DIFF = ACT-DES
                 %IF DIFF < 0 %START
                    DIFF = (-DIFF)!4;    ! MOVE TO HIGHER CYLINDER ADDRESSES
                 %FINISH
                 DIFF = (DIFF+1)!SURFACE
                 RL_DA = DIFF
                 RL_CS = SEEK!DRIVE
                 %WHILE RL_CS&K'200' = 0 %CYCLE;  %REPEAT
                 %IF RL_CS < 0 %THEN ->FLTR
                 RL_MP = COMM;   ! SET WORD COUNT
                 RL_DA = TRACK;           ! SET REQUIRED DISC ADDRESS
                 RL_BA = PAR << 6+P_A2&K'77'
                 RL_CS = COMM2!DRIVE
                 P2_D = (RL INT)&X'00FF'
                                       ! WAIT FOR DISC INTERRUPT
                 POFF(P2)
                 %IF RL_CS < 0 %START

FLTR:
                     RETRY = RETRY-1
                     %IF RETRY > 0 %START
                        I = GET STATUS(K'13')
                        -> AGN
                     %FINISH

                    PX_SERVICE = 7;  PX_REPLY = MID
                    PX_A1 = RL_CS; PX_A3 = GET STATUS(1)
                    PONOFF(PX)
                                       ! ISSUE RESET
                    I = GET STATUS(K'13')
                    FAULT = 5 %AND -> FLT %IF PX_A1 # 0
                    -> AGN
                 %FINISH
              %FINISH
           %FINISH
FLT:       PAR = MAP ABS(P_A2, 0, ID); ! RELEASE SEG
        %FINISH
        P_A1 = FAULT
        P_SERVICE = ID;  P_REPLY = REPLY
        PON(P)
     %REPEAT
%ENDOFPROGRAM