!************
!*  BDK6S   *
!*21.APR.78*
!************
!* N O T E:   MODIFIED TO ADDRESS UNIT 4 (SOFTWARE) AS UNIT 2 (HARDWARE)

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

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


BEGIN 
     SYSTEMINTEGERFNSPEC  GETID
     SYSTEMROUTINESPEC  LINKIN(INTEGER  SER)

     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  SET UNIT 2 = 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, REPLY

     P2 == PX
     MID = GETID
     CYCLE 
        P_SERVICE = 0
        POFF(P)
        FAULT = 0
        ID = P_REPLY;  REPLY = P_SERVICE
        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  REPLY # 3 START 
                DAR = SET UNIT 2
                IF  BLOCK > DKTOP START 
                   DAR = DAR+UNIT1;  BLOCK = BLOCK-DKTOP+DKBOT
                FINISH 
              FINISH 

              IF  BLOCK&UNIT1 # 0 THEN  DAR = DAR+UNIT1 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
                    PX_A2 = 0;          ! 'Not ready'
                    PONOFF(PX)
                    DK_COMM = 1;       ! ISSUE RESET
                     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