! FILE 'dgn1s'
!*********************
!*    dgn1s/dgn1y    *
!* DATE: 10.FEB.82  *
!*********************
!STACK = 140


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

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


%CONSTSTRING (13) VSN = "DGN1:VSN001A
"
%BEGIN
      %PERMROUTINESPEC SVC(%INTEGER EP, R0, R1)
     %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS)
     %SYSTEMROUTINESPEC LINKIN(%INTEGER SER)


     %CONSTBYTEINTEGERNAME ID = K'160030'

      %CONSTINTEGER DGCP SER = 11
      %CONSTINTEGER DGN SER = 26
      %CONSTINTEGER DZ SER = 27;        ! DZ11 HANDLERS ID

      %RECORDFORMAT DGNF(%BYTEINTEGERARRAY A(0:199))

      %RECORDFORMAT LINEF(%INTEGER LINE NO, STATE, ACTIVE, READ ON, %C
      %INTEGERARRAY FLTS(1:4), %INTEGER NAK, DLE, FAULT, %C
      %INTEGER O LEN, I RE TR, I TR, I RX, TERM CH, %C
      SCRIPT ID, OP ADDR, %C
      %RECORD (XXF) %NAME ADDRESS, %BYTEINTEGERARRAY B(0:3), %C
      %RECORD (DGNF) DGN)
               ! FLTS(1) = Overrun, 2 = Framing error, 3 = Crc Fail,
               !      4  = parity error, 5 = shouldn't happen


      %RECORDFORMAT LINE2F(%INTEGERARRAY A(0:30))

     %RECORDFORMAT PE(%BYTEINTEGER SER, REPLY, A1, A2, %C
         %RECORD (DGNF) %NAME B, %BYTEINTEGER C1, C2)

      %RECORDFORMAT P2F(%BYTEINTEGER SER, REPLY, %C
         A1, A2, B1, B2, %INTEGER C)

      %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 (PE)P
      %OWNRECORD (P2F) %NAME P2
      %OWNRECORD (P3F) %NAME P3

      %OWNINTEGERARRAY TIME(0:31)

      %INTEGER I, J
      %OWNINTEGER MON = 0;              ! MONITOR PRINTING FLAG

      !! P R O T    T O   D G C P

      %CONSTINTEGER LINE FAULT = 1
      %CONSTINTEGER LINE ROUND = 2;     ! EOT TO TURN LINE ROUND
      %CONSTINTEGER TRANSMIT DONE = 4;  ! BLOCK HAS BEEN ACKED
      %CONSTINTEGER SELECT = 5
      %CONSTINTEGER STOP = 10

      ! D G C P   T O  P R O T

      %CONSTINTEGER PTXT = 6;           ! PARTIAL TEXT (ADD ETB)
      %CONSTINTEGER TEXT OUT = 7;       ! FINAL TEXT (ADD ETX)
      %CONSTINTEGER FREE BUFF = 8
      %CONSTINTEGER MONITOR = 9;        ! FOR MONITORING PROGRAM

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

      %CONSTINTEGER SOH = 1, STX = 2, ETX = 3, EOT = 4, ACK = 6, %C
                    DLE = X'10', ETB = X'17', NAK = X'15'


      !! S T A T E S  FOR LINES

      %CONSTINTEGER IDLE = 0
      %CONSTINTEGER SOH SENT = 1
      %CONSTINTEGER SOH TIMING = 2
      %CONSTINTEGER MASTER = 3
      %CONSTINTEGER SLAVE = 4
      %CONSTINTEGER DATA = 5

      !! T I M I N G CONSTRAINTS

      ! Repeat Command Delay  600-720 ms
      ! receiver Inhibit Timer 120-240 ms
      ! DLE Delay Time  .84 secs, repeat = 10
      ! Command Timeout 1.2 secs, repeat = 3
      ! Block Reception Time 2 secs, repeat = 3
      %CONSTINTEGER REPEAT COMM DELAY = 6, %C
                    REC INHIBIT DELAY = 2, %C
                    DLE DELAY         = 8, %C
                    COMMAND TIMEOUT   = 12, %C
                    BLOCK TIMEOUT     = 20


      !!  REPLIES FROM LINE HANDLER

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


      %OWNINTEGER CLOCK0

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

      %OWNRECORD (LINEF) %NAME L
      %OWNRECORD (DGNF) %NAME DGN

      %OWNRECORD (LINEF) %ARRAY LINEA(0:31)

      %RECORDFORMAT R1F(%INTEGER X)
      %RECORDFORMAT R2F(%RECORD (DGNF) %NAME R)
      %RECORDFORMAT R3F(%BYTEINTEGERNAME B)
      %RECORDFORMAT R4F(%BYTEINTEGERARRAYNAME AN)

      %RECORD (R1F) R1; %RECORD (R2F) %NAME R2; %RECORD (R3F) %NAME R3
      %RECORD (R4F) %NAME R4

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


     %ROUTINE START INPUT
         P_SER = DZSER; P_REPLY = ID
         P_A1 = LINE INPUT; P_A2 = L_LINE NO
         P_B == L_DGN
         P_C1 = 200; P_C2 = ID;         ! BUFFER BELONGS TO ME
         PON(P)
         L_READ ON = 1
     %END


     %ROUTINE WREPLY(%INTEGER COMM)
        P_SER = DGCP SER;  P_REPLY = ID
         P_A1 = COMM; P_A2 = L_LINE NO
        !! MONITOR(P)
        PON(P)
     %END

     %ROUTINE TELL
         PRINTSTRING("LNE"); WRITE(L_LINE NO, 1); PRINTSYMBOL(':')
     %END

      %ROUTINE DUMP
         %INTEGER I
         TELL; PRINTSTRING("i tr, irx")
         WRITE(L_I TR, 1); WRITE(L_I RX, 1)
         PRINTSTRING(", i re tr"); WRITE(L_I RE TR, 1)
         PRINTSTRING(", Ovrn Framing Crc Parity")
         WRITE(L_FLTS(I), 1) %FOR I = 1, 1, 4
         PRINTSTRING(", Nak Dle Fault")
         WRITE(L_NAK, 1); WRITE(L_DLE, 1); WRITE(L_FAULT, 1)
         %IF L_ACTIVE # 0 %START
            PRINTSTRING(" Currently outputting ")
         %FINISH
         %IF L_READ ON = 0 %START
            PRINTSTRING(" ** no read on **")
         %FINISH
         NEWLINE
      %END

      %ROUTINE DISASTER(%INTEGER REASON, I, J)
         TELL; PRINTSTRING(" ******* DISASTER ********* ")
         WRITE(REASON, 1); WRITE(I, 5); WRITE(J, 5); NEWLINE
         L_STATE = 0
      %END

      %ROUTINE FAULT(%INTEGER REASON, I, J)
         TELL; PRINTSTRING(" Protocol violation "); WRITE(REASON, 1)
         PRINTSTRING(", other info:"); WRITE(I,1); WRITE(J, 1)
         NEWLINE
        %IF MON # 0 %START
           SELECT OUTPUT(1)
           PRINTSTRING("FAULT "); WRITE(REASON, 1)
           WRITE(I, 1); WRITE(J, 1); NEWLINE
           SELECT OUTPUT(0)
        %FINISH
         L_STATE = 0
      %END


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

         %IF TYPE = 1 %START;           ! MESSAGE IN L_B
            R3_B == L_B(0)
            P_B == R2_R
         %ELSE
            !! BLOCK IN DGN
            P_B == DGN
            L_I TR = L_I TR+1
           %IF MON  # 0 %START
              SELECT OUTPUT(1)
              TELL; PRINTSTRING("OUT:"); WRITE(L_STATE, 1)
              WRITE(LEN, 5); NEWLINE
              SELECT OUTPUT(0)
           %FINISH

         %FINISH

         L_ACTIVE = TYPE
         P_A1 = LINE OUTPUT
         P_A2 = L_LINE NO
         %IF L_TERM CH = ETB %THEN P_A2 = P_A2!128;  ! OTHWISE ETX ON LEN>1
         P_C1 = LEN
         P_C2 = L_SCRIPT ID
         P_SER = DZSER; P_REPLY = ID
         PON(P)
     %END
     !!


      %ROUTINE SEND(%INTEGER TYPE)

         L_B(0) = TYPE
         HANDLE OUTPUT(1, 1)
         %IF MON # 0 %START
            SELECT OUTPUT(1)
            TELL; PRINTSTRING("SMA"); WRITE(L_STATE, 1); WRITE(TYPE, 1)
           NEWLINE
            SELECT OUTPUT(0)
         %FINISH
      %END


      %ROUTINE SEND TEXT BLOCK
         R1_X = L_OP ADDR;              ! MAKE IT A RECORD
         DGN == R2_R;                   ! NB: CANT ACCESS IT IN THIS VM
         HANDLE OUTPUT(2, L_OLEN);      ! AND SEND IT
         L_ITR = L_ITR+1
         L_STATE = DATA
         TIME(L_LINE NO) = (CLOCK0+BLOCK TIMEOUT)!1
      %END

!      %ROUTINE MAP BUFFER AND PREPARE
!         %INTEGER X
!         X = L_OP ADDR>>13
!         MAP VIRT(L_SCRIPT ID, X, 4)
!         R1_X = K'100000'!L_OP ADDR&K'17777'
!         PBUFF == R4_AN;                ! THIS MAPS PBUFF TO TEXT ARRAY
!      %END

      %ROUTINE FROM DGCP
         %SWITCH SW(P TXT:MONITOR)

         L == LINEA(P_A2);              ! MAP TO SPECIFIC LINE

         %IF MON # 0 %START
            SELECT OUTPUT(1)
            TELL; PRINTSTRING("DG:"); WRITE(L_STATE, 1); WRITE(P_A1, 1)
            WRITE(P_A2, 1); WRITE(P2_B1, 1); NEWLINE
            SELECT OUTPUT(0)
         %FINISH

         -> SW(P_A1)

SW(P TXT):                              ! PARTIAL TEXT IN
         L_TERM CH = ETB
         -> ROUND

SW(TEXT OUT):
         L_TERM CH = ETX
ROUND:
         L_SCRIPT ID = P2_B1
         L_OP ADDR = P2_C
!         MAP BUFFER AND PREPARE
         %IF L_STATE = IDLE %START
                                        ! ATTEMPT TO BECOME LINK MASTER
            SEND(SOH)
            L_STATE = SOH SENT
            %RETURN
         %FINISH

         %IF L_STATE = MASTER %THEN SEND TEXT BLOCK %AND %RETURN
                                        ! 2ND AND SUBSEQUENT BLOCKS IN SEQ
         FAULT(1, L_STATE, 0)
         %RETURN

SW(FREE BUFF):
         START INPUT;                   ! LET IT GO AGAIN
         %RETURN

SW(MONITOR):
      DUMP
      %END


     %ROUTINE HANDLE INPUT
        %RECORD (DGNF) %NAME DGN
        %INTEGER FIRST, RESP, TYPE
      %SWITCH SW(IDLE:DATA);      ! STATE SWITCH

         DGN == P_B
         L_READ ON = 0

                                       ! P_C2 # 0 IS AN ERROR
         %IF P_C2 # 0 %START
            L_FLTS(P_C2) = L_FLTS(P_C2)+1;   ! ADD TO FAULT COUNT
            FIRST = -1;                 ! MARK IT A FAULTY BLOCK
         %ELSE

            FIRST = L_DGN_A(0);       ! PICK UP 1ST (VALID) CHARACTER
         %FINISH

         !
         ! NB: BOTH VALID DATA & ERRORS ARE CHECKED TO DETERMINE NEXT ACTION
         !

         %IF MON # 0 %START
            SELECT OUTPUT(1)
            TELL; PRINTSTRING("INP:"); WRITE(L_STATE, 1); WRITE(P_C2, 1)
            WRITE(FIRST, 1)
            NEWLINE
            SELECT OUTPUT(0)
         %FINISH

      %IF FIRST = NAK %THEN L_NAK = L_NAK+1
      %IF FIRST = DLE %THEN L_DLE = L_DLE+1

      -> SW(L_STATE)

SW(0):     ! IDLE STATE
      %IF FIRST = SOH %THEN -> SOH IN;  ! OTHER END IS MASTER
      FAULT(2, FIRST, 0)
      ->READ AGN

SW(SOH SENT):
         %IF FIRST = ACK %START
            L_STATE = MASTER
            SEND TEXT BLOCK
            %RETURN
         %FINISH
         TIME(L_LINE NO) = (CLOCK0+REPEAT COMM DELAY)!1
         L_STATE = SOH TIMING
         FAULT(3, FIRST, 0);      ! ONLY DURING TESTING PHASE !!!!!!!!!!!!!!!!!!!!!
         -> READ AGN


SW(SOH TIMING):
         %IF FIRST = SOH %START;        ! OTHER END NOW MASTER
            TIME(L_LINE NO) = 0;        ! CANCEL TIMER
SOH IN:     L_STATE = SLAVE
            SEND(ACK);                  ! ACKNOWLEDGE IT
            L_FAULT = 0
         %ELSE
            FAULT(4, FIRST, 0)
         %FINISH
         -> READ AGN

SW(MASTER):
         FAULT(5, FIRST, 0)
         -> READ AGN

SW(SLAVE):                              ! THIS SHOULD BE TEXT IN
         %IF FIRST = STX %START
            TIME(L_LINE NO) = 0;        ! CANCEL TIMER
            P_B == L_DGN;               ! PASS BUFFERR TO DGCP
            ! P_C1 = LENGTH  (ALREADY THERE)
            WREPLY(SELECT);             ! PASS THE TEXT
            L_FAULT = 0
            %RETURN;                    ! NO READ ON NOW
         %FINISH

         %IF FIRST = EOT %START
            TIME(L_LINE NO) = 0; L_FAULT = 0
            L_STATE= IDLE
            WREPLY(LINE ROUND);         ! END OF THIS TRANSACTION
         %ELSE
            FAULT(6, FIRST, 0)
         %FINISH
         -> READ AGN

SW(DATA):                               ! SHOULD BE AN ACK
         %IF FIRST = ACK %START
            L_FAULT = 0
            WREPLY(TRANSMIT DONE);      ! TELL DGCP THAT ITS GONE
            %IF L_TERM CH = ETX %START; ! WAS THE LAST SECTION OF TEXT
               SEND(EOT);               ! RELINQUISH CONTROL
               L_STATE  = IDLE
            %ELSE
               L_STATE = MASTER;        ! WAIT FOR THE NEXT BLOCK FROM DGCP
               TIME(L_LINE NO) = 0
            %FINISH
         %ELSE
            %IF FIRST = NAK %START
               SEND TEXT BLOCK;         ! REPEAT TRANSMIT
               L_FAULT = L_FAULT+1
               %IF L_FAULT = 5 %THEN DUMP %AND L_FAULT = 0
               L_I RE TR = L_I RE TR+1
            %ELSE
               ! enq or garble - technically different timings !
               TIME(L_LINE NO) = (CLOCK0+REPEAT COMM DELAY)!1
               FAULT(7, FIRST, 0);       ! TESTING ONLY !!!!!!!!!!!!!!!!!
            %FINISH
         %FINISH
         -> READ AGN

READ AGN:                               ! ONLY IF NON-TEXT BUFFER IN
      START INPUT

     %END

      %ROUTINE DO TIMER(%INTEGER N)
         %SWITCH SW(IDLE:DATA)

         L == LINEA(N)
         TIME(N) = 0
         %IF MON # 0 %START
            SELECT OUTPUT(1)
            PRINTSTRING("Timer, state = "); WRITE(L_STATE, 1)
            SPACES(3); DUMP
            SELECT OUTPUT(0)
         %FINISH

         L_FAULT = L_FAULT+1
         %IF L_FAULT = 5 %THEN DUMP %AND L_FAULT = 0

         -> SW(L_STATE)

SW(IDLE):                               ! ERROR
SW(MASTER):
         FAULT(10, L_STATE, 0)
         %RETURN

SW(SOH SENT):
SW(SOH TIMING):
         SEND(SOH)
         %RETURN

SW(SLAVE):
         SEND(ACK)
         %RETURN

SW(DATA):
         SEND TEXT BLOCK
         L_I RE TR = L_I RE TR+1
      %END


     %ROUTINE CLOCK INT
         %INTEGER I
        ALARM(5);                   !RESTART CLOCK FOR 100 MS
         CLOCK0 = CLOCK0+1
         CLOCK0 = 1 %IF CLOCK0 = 0
         %CYCLE I = 0, 1, 31
            %IF TIME(I) = CLOCK0 %THEN DO TIMER(I)
         %REPEAT
     %END
     !!

      R2 == R1; R3 == R2; R4 == R3

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


      ALARM(25)
      PRINTSTRING(VSN)

     %CYCLE
        P_SER = 0
        POFF(P)
         %IF P_REPLY = DZSER %START;    ! INTERRUPT
            L == LINEA(P_A2)
            %IF P_A1 = LINE OUTPUT %START
               L_ACTIVE = 0
            %ELSE
               HANDLE INPUT
            %FINISH
            CLOCK0 = 0
            %CONTINUE
         %FINISH

           %IF P_REPLY = 0 %START
              CLOCK INT;               ! CLOCK INTERRUPT
               %IF INT = '?' %START
                  INT = 0
                  WRITE(CLOCK0,4)
                  NEWLINE
                  DUMP
               %FINISH

               %IF 'M'<=INT<='O' %THEN MON=INT-'0' %AND INT = 0


           %CONTINUE
        %FINISH

        !! USER REQUEST
        !! MONITOR(P)
         FROM DGCP
      %REPEAT
%ENDOFPROGRAM
                  %REPEAT