!**********
!*  BDK4S *
!**********

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

%PERMINTEGERFNSPEC SVC(%INTEGER EP, P1, P2)
%PERMINTEGERMAPSPEC INTEGER
%PERMBYTEINTEGERMAPSPEC BYTEINTEGER
%PERMINTEGERFNSPEC ADDR
%PERMINTEGERFNSPEC ACC


%BEGIN
     %SYSTEMINTEGERFNSPEC GETID

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

     %RECORDFORMAT DKF(%INTEGER DST, ERR, COMM, WC, ADD, DAR)
     %CONSTRECORD (DKF) %NAME DK = K'177400'

     %CONSTINTEGER DKTOP = 4871
     %OWNINTEGER DK BOT = K'77'

     %CONSTINTEGER UNIT1 = K'020000'
     %CONSTINTEGER UNIT2 = K'040000'


     %CONSTINTEGERARRAY LOOK UP(0:1) = K'505', K'503'
     !! READ (0) AND WRITE (1) COMMANDS FOR THE RK05


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

     %INTEGER PAR, ID, BLOCK, ADD, COMM, BL
     %INTEGER DAR, SECTOR, COMM2, MID, FAULT

     P2 == PX
     MID = GETID
     %CYCLE
        P_SERVICE = 0
        POFF(P)
        FAULT = 0
        ID = P_REPLY
        %IF P_A2 = 0 %START
           DK BOT = 0;  FAULT = 9
        %ELSE
           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&UNIT1 # 0 %THEN DAR = UNIT2 %AND BLOCK = %C
                BLOCK&(UNIT1-1)
              %IF BLOCK < DKBOT %OR BLOCK > DKTOP %THEN FAULT = 4 %C
                %ELSESTART
                 COMM =- (P_A1 >> 1)
                 %IF COMM = 0 %THEN COMM =- 256
AGN:             DK_ADD = PAR << 6+P_A2&K'77'
                 BL = BLOCK//12
                 DK_DAR = DAR!(BL << 4)!(BLOCK-BL*12)
                 DK_WC = COMM
                 DK_COMM = COMM2

                 P2_D = (-3)&X'00FF';  ! WAIT FOR DISC INTERRUPT
                 POFF(P2)

                 %IF DK_COMM < 0 %START
                    PX_SERVICE = 7;  PX_REPLY = MID
                    PX_A1 = DK_ERR
                    PONOFF(PX)
                    DK_COMM = 1;       ! ISSUE RESET
                    -> AGN
                 %FINISH
              %FINISH
           %FINISH
           PAR = MAP ABS(P_A2, 0, ID); ! RELEASE SEG
        %FINISH
        P_A1 = FAULT
        P_SERVICE = ID;  P_REPLY = 3
        PON(P)
     %REPEAT
%ENDOFPROGRAM