!************
!*  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