! FILE 'XBUR1S'
!*********************
!*    xbur1S/xbur1Y    *
!* DATE: 20.AUG.81  *
!!!!!!!!!!!!!!!!!!!!!!
!STACK = 140


%RECORDFORMAT XXF(%INTEGER DUMMY)
%CONSTRECORD (XXF) %NAME NULL = 0

%CONTROL X'100001';                    ! TRUSTED PROGRAM AND QUICK
                                       ! ROUTINE ENTRY AND EIS


%CONSTSTRING (7) VSN = 'VSN001B'
%BEGIN
     %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS)
     %SYSTEMROUTINESPEC LINKIN(%INTEGER SER)

      %RECORDFORMAT PARF(%INTEGER TYPE, %RECORD (XXF) %NAME B, %C
        %INTEGER LEN)

      %EXTERNALROUTINESPEC DU11E(%RECORD (PARF) %NAME L)
      %EXTERNALROUTINESPEC DUP11E(%RECORD (PARF) %NAME B)

     %CONSTBYTEINTEGERNAME ID = K'160030'

      %CONSTINTEGER KERNEL SER = 11
      %OWNINTEGER LINE TYPE = 0;        ! 0=DQS11, 1=DUP11E
     %OWNINTEGER LINE = 0;        !LOGICAL LINE
     %OWNRECORD (XXF) %NAME HANDLER ADDRESS = 1;     ! SET BY INITIATING PROG
      %OWNINTEGER RX INT = -7, TX INT = -6

      %RECORDFORMAT XBMF(%BYTEINTEGER F, S, T, FO, FI)

      %RECORDFORMAT XBM2F(%BYTEINTEGERARRAY A(0:100))

     %RECORDFORMAT PE(%BYTEINTEGER SER, REPLY, %INTEGER A, B, C)
      %RECORDFORMAT P2F(%BYTEINTEGER SER, REPLY, %INTEGER COMM, %C
         %BYTEINTEGER B1, B2, %RECORD (XBMF) %NAME M)

      %RECORDFORMAT P3F(%BYTEINTEGER SER, REPLY, LINE, LINE TYPE, %C
        %RECORD (XXF) %NAME AD, %BYTEINTEGER RXINT, TXINT)

      %RECORDFORMAT BUFFF(%RECORD (BUFFF) %NAME B, %BYTEINTEGERARRAY %C
        A(0:1999))
         %OWNRECORD (PARF) PAR

     %OWNRECORD (PE)P
      %OWNRECORD (P2F) %NAME P2
      %OWNRECORD (P3F) %NAME P3
      %INTEGER I, J
     %OWNINTEGER ACTIVE
     %OWNINTEGER WSNO;              !SERVICE NOS FOR REPLY
     %OWNINTEGER INPUT EXP;               !BLOCKS OF INPUT EXPECTED

      !! P R O T    T O   S I V C

      %CONSTINTEGER PRESELECT = 1
      %CONSTINTEGER POLL  = 2
      %CONSTINTEGER SELECT = 3
      %CONSTINTEGER HELLO = 4
      %CONSTINTEGER FAST SELECT = 9
      %CONSTINTEGER STOP = 10

      ! S I V C  T O  P R O T

      %CONSTINTEGER PACK = 5
      %CONSTINTEGER NACK = 6
      %CONSTINTEGER TXT = 7
      %CONSTINTEGER FREE BUFFER = 8
      %CONSTINTEGER POLL CONT = 11

      !! C H A R   V A L U E S

      %CONSTINTEGER ACK = 6
      %CONSTINTEGER NAK = X'15'
      %CONSTINTEGER EOT = 4
      %CONSTINTEGER SOH = 1
      %CONSTINTEGER STX = 2
      %CONSTINTEGER POL = X'70'
      %CONSTINTEGER FSL = X'73'
      %CONSTINTEGER SEL = X'71'


%CONSTINTEGER INITIALISE = 0;    ! CALLS & REPLIES TO LINE HANDLER ROUTINES
     %CONSTINTEGER LINE INPUT = 1
     %CONSTINTEGER LINE OUTPUT = 2
      %CONSTINTEGER INPUT HERE = 3
      %CONSTINTEGER OUTPUT DONE = 4


      %OWNINTEGER IRD, I TR, POLL RD, ARD, NRD, ACK TR, CRC FAIL
      %OWNINTEGER BAD ACK, BAD FR, DM, SILO FULL, I RE TR
      %OWNINTEGER COMM, ADD, SEG, CLOCK0, SIVC RESPOND
      %OWNINTEGER O LEN, SER PT

     %RECORDFORMAT WDSE(%RECORD (XBMF) %NAME M, %INTEGER LEN)
     %RECORDFORMAT BPF(%RECORD (XBMF) %NAME M)

      %RECORDFORMAT XXF(%INTEGER LEN, %RECORD (XBMF) XBM)
      %RECORD (XXF) %NAME XF

     %OWNRECORD (XBM2F) XBM2
      %OWNRECORD (XBMF) %NAME XBM
     %OWNRECORD (WDSE) ICURR
     %OWNRECORD (WDSE) %NAME IPOOL, IP2
     %OWNRECORD (XBMF) OM
     %OWNRECORD (BPF) %NAME IM

      %RECORDFORMAT R1F(%INTEGER X)
      %RECORDFORMAT R2F(%RECORD (XBMF) %NAME R)

      %RECORD (R1F) R1; %RECORD (R2F) %NAME R2

      %CONSTBYTEINTEGERNAME CHANGE OUT ZERO = K'160310'
      %CONSTINTEGER T3 SER = 21
      %CONSTBYTEINTEGERNAME INT = K'160060'

      %RECORDFORMAT M1F(%INTEGER A, B, C, D, E, F)
      %RECORD (M1F) M1

      %OWNRECORD (BUFFF) %ARRAY BUFF(0:1)

     %ROUTINE START INPUT
         PAR_TYPE = LINE INPUT; PAR_B == ICURR_M; PAR_LEN = ICURR_LEN
         %IF LINE TYPE = 0 %START
            DU11E(PAR)
         %ELSE %IF LINE TYPE = 1 %START
            DUP11E(PAR)
         %FINISH
     %END


     %ROUTINE WREPLY(%INTEGER COMM, FLAG)
        %RETURNIF WSNO = 0
        P_SER = WSNO;  P_REPLY = ID
         P2_COMM = COMM
        P_B = LINE
        !! MONITOR(P)
        PON(P)
     %END

     %ROUTINE TELL
         PRINTSTRING("PRT");  PRINTSYMBOL(LINE+'0'); PRINTSYMBOL(':')
     %END


     %ROUTINE HANDLE OUTPUT(%INTEGER TYPE)
        CLOCK0 = 0

         %IF TYPE = 1 %START;           ! ACK (IN OM)
            PAR_B == OM; PAR_LEN = 1
            ACK TR = ACK TR+1
         %ELSE
            !! BLOCK IN XBM, LENGTH IN OLEN
            PAR_B == XBM; PAR_LEN = OLEN&X'FF'
            I TR = I TR+1
         %FINISH

         ACTIVE = TYPE
         PAR_TYPE = LINE OUTPUT
         %IF LINE TYPE = 0 %START
            DU11E(PAR)
         %ELSE %IF LINE TYPE = 1 %START
            DUP11E(PAR)
         %FINISH
     %END
     !!


     %ROUTINE HANDLE INPUT
        %RECORD (XBMF) %NAME XBM
         %RECORD (XBMF) %NAME M
        %INTEGER FIRST
         M == ICURR_M
         XBM == PAR_B;              ! NB: XBM AND M ARE PICKED UP SEPERATELY !!!!!!
         %UNLESS XBM == M %START
            TELL; PRINTSTRING("BAD ADDRESS
")
            %CYCLE;%REPEAT
         %FINISH


                                       ! PAR_LEN<0 BUFFER TOO SMALL
         %IF PAR_LEN < 0 %START
            %IF PAR_LEN = -3 %START
               CRC FAIL = CRC FAIL+1;   ! BUT PASS TO SIVC NEVERTHELESS
            %ELSE
               %IF PAR_LEN = -1 %START
                   DM = DM+1
               %ELSE %IF PAR_LEN = -2 %START
                  BAD FR = BAD FR+1
               %FINISH
               -> NOISE
            %FINISH
         %FINISH

         %IF SIVC RESPOND = 1 %START;  ! SIVC STILL HAS TO RESPOND
            DM = DM+1;                 ! JUNK IT
            -> NOISE
         %FINISH

         FIRST = XBM_F
         %IF FIRST = ACK %START;        ! TEXT OK
            WREPLY(POLL CONT, 0)
            ARD = ARD+1
            -> NOISE
         %FINISH

         %IF FIRST = NAK %START;        ! TEXT REJECTED
            !! SEND TEXT AGAIN
            HANDLE OUTPUT(2)
            NRD = NRD+1
            -> NOISE
         %FINISH

         %IF FIRST = EOT %START;        ! NO TEXT
            %IF XBM_FO = FSL %START;    ! FAST SELECT
               ! ?????
               -> NOISE
            %FINISH

            %UNLESS PAR_LEN # 5 %START
               PRINTSTRING("XBM: POLL WRONG LENGTH, LENGTH =")
               WRITE(PAR_LEN, 1); NEWLINE
                -> NOISE
            %FINISH
            P2_B1 = LINE
            %IF XBM_FO = POLL %START
               P2_COMM = POLL
               P2_B1 = XBM_S; P2_B2 = XBM_T
               POLL RD = POLL RD+1
               SIVC RESPOND = 1;       ! AWAIT A RESPONE
            %ELSE
               %IF XBM_FO # SEL %START
                  PRINTSTRING("BURR: PROTOCOL FUNNY, F0 ="); WRITE(XBM_FO, 1)
                  NEWLINE
                  -> NOISE
               %FINISH
               ! IS A SELECT
               P2_COMM = PRE SELECT
            %FINISH
            P_SER = KERNEL SER; P_REPLY = ID
            PON(P)
         %ELSE;                         ! SELECT
            %IF FIRST # SOH %START;     ! ERROR
               TELL; PRINTSTRING("XBM ERROR, FIRST BYTE =")
               WRITE(FIRST, 1); NEWLINE
               -> NOISE
            %FINISH

            P2_M == XBM;                ! NB: PASSED IN MY SEG
            P2_B1 = LINE
            %IF XBM_T = STX %START;     ! BIT FOR LOOP BACK ONLY
               ! MOVE ONE BYTE DOWN BUFFER?
               R2_R == XBM
               R1_X = R1_X-1
               XBM == R2_R;             ! NASTY, HORRIBLE
            %ELSE;                      ! 'NORMAL' SELECT
            %FINISH

            I RD = I RD+1
            SIVC RESPOND = 1;          ! AWAIT A RESPONSE
            P2_M == XBM
            P_SER = KERNEL SER; P_REPLY = ID
            P2_COMM = SELECT
            %IF PAR_LEN = -3 %THEN P2_B2 = 255; ! PASS CKSM FAULT THRU
            PON(P)
            XBM == NULL
         %FINISH

NOISE:  
        %IF %NOT XBM == NULL %AND %NOT ICURR_M==IM %START
        !! USE THE SAME ONE AGAIN
        %ELSE
           %IF INPUT EXP > 0 %START
              ICURR_M == IPOOL
              IPOOL == IPOOL_M; INPUT EXP = INPUT EXP-1
               ICURR_LEN = 2000
           %ELSE
              ICURR_M == IM;  ICURR_LEN = 6
           %FINISH
        %FINISH
        START INPUT
!        HANDLE OUTPUT
     %END


     %ROUTINE CLOCK INT
        ALARM(25);                   !RESTART CLOCK
         CLOCK0 = CLOCK0+1
     %END
     !!

      R2 == R1
     IM == M1

      CHANGE OUT ZERO = T3 SER
      P2 == P;  P3 == P2

      P2_SER = 0;  POFF(P2);              ! WAIT FOR INSTRUCTIONS
      LINE = P3_LINE;  LINE TYPE = P3_LINE TYPE
       HANDLER ADDRESS == P3_AD
      RXINT = P3_RXINT!X'FF00';  TXINT = P3_TX INT!X'FF00'
       LINKIN(RXINT); LINKIN(TXINT)
      MAP VIRT(KERNEL SER, 6, 4);       ! MAP KERNEL SEG 6 TO MY 4

       PAR_TYPE = INITIALISE
       PAR_B == HANDLER ADDRESS
       %IF LINE TYPE = 0 %START
           DU11E(PAR)
       %ELSE %IF LINE TYPE = 1 %START
           DUP11E(PAR)
       %FINISH

      IPOOL == BUFF(0)
      BUFF(0)_B == NULL
      INPUT EXP = 1

      WSNO = KERNEL SER;      ! SAY HELLO TO KERNEL
      WREPLY(HELLO, 0);           ! HERE I AM ( LINE NUMBER! = 0!)
      ALARM(25)
      ICURR_M == BUFF(1);  ICURR_LEN = 2000
      START INPUT

     %CYCLE
        P_SER = 0
        POFF(P)
         %IF P_SER&X'80' # 0 %START;    ! INTERRUPT
            %IF P_SER = TX INT&X'FF' %THEN I = OUTPUT DONE %ELSE %C
               I = INPUT HERE
            PAR_TYPE = I
            %IF LINE TYPE = 0 %START
               DU11E(PAR)
            %ELSE %IF LINE TYPE = 1 %START
               DUP11E(PAR)
            %FINISH
            %IF PAR_TYPE = LINE OUTPUT %START
               ACTIVE = 0
            %ELSE
               HANDLE INPUT
            %FINISH
            %CONTINUE
         %FINISH

           %IF P_REPLY = 0 %START
              CLOCK INT;               ! CLOCK INTERRUPT
               %IF INT = '?' %START
                  INT = 0
                  PRINTSTRING("Active, Buff, Clock0 ")
                  WRITE(ACTIVE, 2); WRITE(INPUT EXP, 2); WRITE(CLOCK0, 2)
                  NEWLINE
                  PRINTSTRING("I Rx, Poll Rx, Ack Rx, Nak Rx ")
                  WRITE(I RD, 3); WRITE(POLL RD, 3); WRITE(ARD, 3); WRITE(NRD, 3)
                  PRINTSTRING("
I Tx, Ack Tx")
                  WRITE(I TR, 2); WRITE(ACK TR, 2)
                  PRINTSTRING("
Bad Ack, Bad Fr, Overrun, Data missed")
                  WRITE(BADACK, 2); WRITE(BADFR, 2); WRITE(SILOFULL, 2)
                  WRITE(DM ,2)
                  NEWLINE
                  PRINTSTRING("Crc Fail, Upper to Respond")
                  WRITE(CRC FAIL, 2); WRITE(SIVC RESPOND,  2)
                  NEWLINE
               %FINISH

               %IF INT = 'A' %START; ! STOP ALL
                  WREPLY(STOP, 0);       ! STOP SIVC
                  %STOP
               %FINISH
               %IF INT = 'T' %START
                   INT = 0
                   PROMPT("DATA?")
                   %CYCLE I = 0, 1, 100
                      READ(J)
                      %EXIT %IF J < 0
                      XBM2_A(I) = J
                   %REPEAT
                   P_B = I; XBM == XBM2
                   HANDLE OUTPUT(2)
                   %CONTINUE
               %FINISH

           %CONTINUE
        %FINISH

        !! USER REQUEST
        !! MONITOR(P)
         COMM = P2_COMM
         %IF COMM = TXT %START
            ! SEND TEXT, BUFFER IN P_A3, ADDRESS IN OTHER TASK
            SIVC RESPOND = 0
            %IF ACTIVE # 0 %START;      ! ITS BUSY !
               TELL; PRINTSTRING("ALREADY TRANSMITTING
")
               %CONTINUE
            %FINISH

            ADD = P_C
            SEG = ADD>>13
            SER PT = P2_B1
            MAP VIRT(SER PT, SEG, 4);    ! MY SEG 4 - SCRIPT TASK BUFFER
            %IF SEG # 6 %START
               TELL; PRINTSTRING("UNEXPECTED SEG =")
               WRITE(SEG, 1); NEWLINE
               %CONTINUE
            %FINISH
            R1_X = ADD&K'17777'!K'100000'
            XF == R2_R
            XBM == XF_XBM
            OLEN = XF_LEN
            HANDLE OUTPUT(2);           ! ACTUALLY OUTPUTS IT
            %CONTINUE
         %FINISH

         %IF COMM = FREE BUFFER %START
            P_C = P_C+1&X'FFFE';        ! FOR LOOP BACK TESTS
            IP2 == P2_M
            IP2_M == IPOOL
            IPOOL == IP2
            INPUT EXP = INPUT EXP+1
            %CONTINUE
         %FINISH

         %IF COMM # PACK %AND COMM # NACK %START
            TELL; PRINTSTRING("BAD COMMAND FROM SIVC, VALUE =")
            WRITE(COMM, 1); NEWLINE
            %CONTINUE
         %FINISH

         SIVC RESPOND = 0
         OM_F = P2_B1
         %IF COMM = PACK %THEN OM_F = ACK %ELSE OM_F = NAK
         HANDLE OUTPUT(1)
         %CONTINUE
      %REPEAT
%ENDOFPROGRAM