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