!****************
!* LKDL2S/LKDL2Y *
!* DATE: 18.FEB.80  *
!* HANDLES DIRT&DISC *
!* REQUESTS BY SENDING *
!* THEM DOWN A DL11    *
!***********************
%CONTROL K'101011';                    ! 'SYSTEM' PROGRAM (FAST
                                       ! ROUTINE ENTRY/EXIT)
%PERMINTEGERFNSPEC SVC(%INTEGER EP, P1, P2)
%SYSTEMROUTINESPEC LINKIN(%INTEGER SEG)
%SYSTEMROUTINESPEC MAPHWR(%INTEGER SEG)
%SYSTEMINTEGERFNSPEC GETID


%BEGIN

     %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS)
     %RECORDFORMAT PF(%BYTEINTEGER SER, REPLY, %INTEGER A, B, C)
     %RECORDFORMAT P2F(%INTEGER D)
     %RECORDFORMAT P3F(%BYTEINTEGERARRAY A(0:7))
     %RECORDFORMAT PRF(%INTEGER RSR, RDB, TSR, TDB)

     %RECORDFORMAT DESF(%INTEGER PT, %BYTEINTEGER STATE, S1, %C
       %INTEGER MAX LEN, P1, FLAG, SEG, SA, VEC)
     %RECORDFORMAT DES2F(%RECORD (DESF) RX, TX)


     %RECORDFORMAT R1F(%INTEGER N)
     %RECORDFORMAT R2F(%RECORD (DES2F) %NAME DES)

     %CONSTRECORD (PRF) %NAME PR = K'117550'
                                       ! IN SEG 4 (REALLY A PUNCH!!)
     %CONSTBYTEINTEGERNAME ID = K'160030'
     %CONSTINTEGERNAME PS = K'117776'

     %CONSTINTEGER RL SER = 3
     %CONSTINTEGER READ R = 0
     %CONSTINTEGER WRITE R = 1
     %CONSTINTEGER DIR SER = 4

     %CONSTINTEGER EOT = 4
     %RECORD (PF)P, P4
     %RECORD (P2F) %NAME P2
     %RECORD (P3F) P3
     %RECORD (PF) %NAME P3X
     %RECORD (DES2F) %NAME DES
     %RECORD (R1F) R1; %RECORD (R2F) %NAME R2

     %CONSTINTEGER MYSEG = 5, MYSEGA = K'120000'

     %INTEGER I, MID, SEG, REPLY, LEN, N, PT, PA2, J, FLAG
      %INTEGER CALL, TOUT, RFLAG, PA, PAR, MYPAR

     %RECORDFORMAT BUFF(%BYTEINTEGERNAME B)
     %RECORDFORMAT BUXF(%INTEGER PT)
     %RECORD (BUFF)BUF
     %RECORD (BUXF) %NAME BUX
     %OWNBYTEINTEGERARRAY MYBUFF(0:512)

     %ROUTINESPEC DELAY(%INTEGER COUNT)

     %ROUTINE PRINT PARAMS(%RECORD (PF) %NAME P)
       WRITE(P_SER, 1); WRITE(P_REPLY, 1)
       WRITE(P_A, 5); WRITE(P_B, 1); WRITE(P_C, 1)
       NEWLINE
     %END

     %ROUTINE PUT 8 BYTE READ ON
        %INTEGER CAD
        R2_DES == P3
        CAD = R1_N
        CAD = CAD&K'17777'!K'140000';  ! IN SEG 6
        DES_RX_MAX LEN = 8
        DES_RX_SEG = MYPAR
        DES_RX_PT = CAD
        R FLAG = 1
        PR_RSR = PR_RSR!K'100';  ! PUT INT ON
     %END

     %ROUTINE PUT 8 BYTES
        %INTEGER CAD
        R2_DES == P
        CAD = R1_N&K'17777'!K'140000'
        DES_TX_SEG = MYPAR
        DES_TX_PT = CAD
        DES_TX_SA = 8
        DES_TX_STATE = 1
        PR_TDB = 8
        PR_TSR = PR_TSR!K'100';   ! TRANSMIT LENGTH&PUT INTS ON
     %END

     %ROUTINE DELAY(%INTEGER COUNT)
        %INTEGER I
        I = SVC(18, 0, 0);               ! DROP PRIORITY TO FORCE DELAY
        %CYCLE I = 1, 1, COUNT; %REPEAT
        I = SVC(18, 3, 0);               ! PUT IT BACK AGAIN
     %END

      I = SVC(18, 3, 0);                    ! PUT PRIORITY=3
     MID = GETID
     MAP HWR(4)
     I = PR_RDB;               ! ENSURE JUNK IS CLEAR
     LINKIN(-31); LINKIN(-32); ! RECEIVE & TRANSMIT INTERRUPTS
     BUX == BUF;  P2 == P;  P3X == P3
     BUF_B == MYBUFF(0)
    SEG = 0; PT=0

     I = SVC(22, 3, 0);               ! MAP TO DL DESCRIPROR AREA
     R2 == R1
     R1_N = I&K'77'!K'060000';                  ! JUST THE PAGE DISPLACEMENT IN SEG 3
     DES == R2_DES

     DES_RX_VEC = K'176510';          ! PUNCH/READER IN NON-DISC MACH
     DES_TX_VEC = K'176510'

     MYPAR = MAP ABS(K'140000', 256, MID); ! GET OWN BUFFER MAPPING

     PUT 8 BYTE READ ON


     PS = PS&K'177400';               ! ENSURE PRIO IS 0



     ALARM(50)

     %CYCLE
        P_SER = 0; POFF(P)
        %IF P_REPLY = 0 %THEN -> RECEIVE

!        %IF RFLAG # 0 %THEN J = -5 %AND -> FLT
        ! TEST ABOVE NO GOOD, BUT MUST HAVE IT IN SOME FORM FOR SAFETY

           %IF CALL = 0 %START
              PRINTSTRING("LINK: BAD SER")
              WRITE(P_SER, 1); WRITE(P_REPLY, 1); NEWLINE
              %CYCLE; %REPEAT
              %CONTINUE
           %FINISH

           SELECT OUTPUT(1)
           PRINTSTRING("PON RECD ")
           PRINT PARAMS(P)
           SELECT OUTPUT(0)

           FLAG = 1
           P_SER = REPLY;              ! RE-INSTATE PROPER CALLER
           PUT 8 BYTES;                 ! SEND THE REQUEST
           %IF CALL = RL SER %AND PA = READ R %START;      ! RL01 READ REQUEST
              LEN = 511
              P4_SER = -32; P4_REPLY = 0; POFF(P4); ! WAIT FOR DONE
               DELAY(500)
               DES_TX_SEG = MYPAR
               DES_TX_PT = BUX_PT&K'17777'!K'140000';  ! IN SEG 6
               DES_TX_SA = LEN+1
               DES_TX_STATE = 1;                   ! ALLOW IT INTS
               %IF LEN = 26 %THEN I = 25 %ELSE I = 255
               PR_TDB = I
               PR_TSR = PR_TSR!K'100'
               FLAG = 2
           %FINISH
       PUT 8 BYTE READ ON;             ! NOW ALLOW THE READ AGAIN
       P4_SER = -32; P4_REPLY = 0; POFF(P4);  ! WAIT FOR DONE
       CALL = 0
     %CONTINUE

RECEIVE:
     %IF P_SER = MID %START;     ! CLOCK INT
        ALARM(50);               ! ON AGAIN
        %IF TOUT # 0 %START
           TOUT = TOUT-1
           %IF TOUT = 0 %THEN J = -1 %AND -> FLT
        %FINISH
        %CONTINUE
     %FINISH


       ! NOW RECEIVE INTS


        %IF DES_RX_FLAG # 0 %START
           J = DES_RX_FLAG
           -> FLT
        %FINISH
        %IF RFLAG = 0 %THEN J = -2 %AND -> FLT

        %IF RFLAG = 1 %START ;        ! RL01 READ, SO BLOCK COMING
          RFLAG = 0
          SELECT OUTPUT(1)
          PRINTSTRING("DL11 IN:"); PRINT PARAMS(P3)
          SELECT OUTPUT(0)

          CALL = P3X_SER; REPLY = P3X_REPLY; PA = P3X_A; PA2 = P3X_B

          %IF CALL = RL SER %AND PA = READ R %THEN P3X_B = BUX_PT

          %IF (CALL = RL SER %AND PA = WRITE R) %C
            %OR CALL = DIR SER %START

             P3X_B = BUX_PT;          ! BLOCK IS IN THIS AREA
             %IF CALL = DIR SER %THEN LEN = 26 %ELSE LEN = 512
              DES_RX_MAX LEN = LEN
              DES_RX_SEG = MYPAR
              DES_RX_PT = BUX_PT&K'17777'!K'140000'
              RFLAG = 2;             ! FLAG BIG BLOCK COMING
              PR_RSR = PR_RSR!K'100'; ! INTS ON
              %CONTINUE;             ! WAIT FOR IT
           %FINISH
           P3X_REPLY = MID
           PON(P3);                   ! PON USERS MESSAGE UP
           TOUT = 0
           %CONTINUE
        %FINISH
        ! RFLAG = 2, BIG BLOCK ARRIVED
        P3X_REPLY = MID
        PON(P3)
        TOUT = 0;                   ! TURN TIMER OFF AGAIN
        %CONTINUE


FLT:
       SELECT OUTPUT(1)
          PRINTSTRING("FAULT ")
          WRITE(J, 1)
          WRITE(RFLAG, 1); NEWLINE
       SELECT OUTPUT(0)
        P_SER = 7; P_REPLY = MID
        P_A = J
        PON(P)
        DELAY(10000) %UNLESS J = -1
        PUT 8 BYTE READ ON
     %REPEAT

%ENDOFPROGRAM