! FILE 'FEP_DQS12E'
!**************
!*  DQS12E    *
!*DA:14.APR.80*
!**************

%CONTROL K'100001';                    ! 'SYSTEM' PROGRAM AND
                                       ! TRUSTED PROG


%RECORDFORMAT PARF(%INTEGER TYPE, ADDRESS, LEN)

%EXTERNALROUTINE DQS11E(%RECORD (PARF) %NAME P)

     %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEG)
     %SYSTEMINTEGERFNSPEC GETID
     %SYSTEMROUTINESPEC LINKIN(%INTEGER SER)
     %SYSTEMINTEGERFNSPEC MAP ABS(%INTEGER ADR, LEN, REQ ID)

     %RECORDFORMAT PF(%BYTEINTEGER SER, REPLY, %INTEGER A1, A2, A3)

     %RECORDFORMAT DQS11F(%INTEGER MCSR, TCSR, RSR, RCR, TWCR, TCAR, %C
       RWCR, RCAR)

     %OWNRECORD (DQS11F) %NAME DQS = 1;    ! SET UP BY PROT ON INITIALISE

      %RECORDFORMAT PAR2F(%INTEGER TYPE, %RECORD (DQS11F) %NAME ADDRESS,LEN)

      %RECORD (PAR2F) %NAME P2

      %CONSTINTEGER INITIALISE = 0
     %CONSTINTEGER LINE INPUT = 1
     %CONSTINTEGER LINE OUTPUT = 2
      %CONSTINTEGER INPUT HERE = 3
      %CONSTINTEGER OUTPUT DONE = 4
      %CONSTINTEGER MODEM STATUS = 5


     %CONSTINTEGER TXGO = K'111'
     %CONSTINTEGER RXGO = K'111'

     %OWNINTEGER TX REPLY, RX REPLY

     %ROUTINESPEC OCTAL(%INTEGER N)

      %SWITCH TYPESW(INITIALISE:MODEM STATUS)


     %OWNINTEGER TYPE, F, CAD, OSEG, I, EXT BITS
     %OWNINTEGER PAR, MID, PAD

      %OWNINTEGERARRAY RADDR(0:7)

      -> TYPE SW(P_TYPE)

TYPE SW(INITIALISE):
     MID = GET ID
     MAPHWR(3)
     P2 == P
     DQS == P2_ADDRESS
     DQS = 0;                          ! TIDY IT UP FIRST
     DQS_MCSR = K'40003';              ! DON'T TRANSFER THE CRC
     DQS_RCR = K'10';                  ! ENABLE RECEIVER
     DQS_TCSR = K'10';                 ! ENABLE TRANSMITTER
     %CYCLE I = 1, 1, 7;              ! FIND ABSOLUTE ADDRESSES
        RADDR(I) = MAP ABS(I<<13, 256, MID); ! MY ADDRESSES
        F = MAP ABS(I<<13, 0, MID);      ! AND OFF AGAIN
      %REPEAT
      RX REPLY = 0; TX REPLY = 0
      %RETURN

TYPE SW(OUTPUT DONE):
                                       ! TRANSMITTER
              TYPE = LINE OUTPUT
              %IF DQS_TCSR < 0 %OR TXREPLY = 0 %START
                 !! TRANSMITTER ERROR
                 PRINTSTRING('TX ERROR
')
                 P_LEN = 1
              %ELSE
                 P_LEN = 0
              %FINISH
            P_TYPE = LINE OUTPUT
              TXREPLY = 0
              %RETURN

TYPE SW(INPUT HERE):
              !! RECEIVER INTERRUPT
              %IF DQS_RSR&K'34067' # 0 %OR RX REPLY = 0 %START
                 F = -2;          ! FRAME ERROR
                 %IF DQS_RSR&K'20' # 0 %THEN F = -3;  ! SILO FULL
FLT:             DQS_RCR = 0;          ! CLEAR DOWN
                 DQS_RCR = K'10';      ! AND UP AGAIN
              %ELSE
                 %IF DQS_RSR&K'1000' # 0 %THEN F = -1 %AND -> FLT
                                       ! WC OVERFLOW
                 F = DQS_RCAR-CAD-2 
                                       ! NUMBER OF BYTES TRANS
                 %IF DQS_RSR&K'074000' # 0 %THEN F = F-1
                  %IF F> 252 %START
                      PRINTSTRING("DQS NASTY:")
                      OCTAL(DQS_RCAR); SPACE; OCTAL(CAD); SPACE; OCTAL(F);NEWLINE

                  %FINISH
               %FINISH
               P_TYPE = LINE INPUT
              P_ADDRESS = PAD;         ! PASS BLOCK ADDRESS BACK
               P_LEN = F
              RX REPLY = 0
            %RETURN

TYPE SW(LINE INPUT):
           !! USER CALL
              !! READ REQUEST
              %IF RX REPLY # 0 %THEN -> ABORT
              RXREPLY = MID
              PAD = P_ADDRESS
!              PAR = MAP ABS(PAD, P_LEN, RXREPLY)
              PAR = RADDR(PAD>>13)
              %IF PAR = 0 %THEN -> ABORT
              PAR = PAR+(PAD&K'17700')>>6; ! ENSURE ACTUAL BLOCK
              EXT BITS = (PAR&K'176000')>>6
              CAD = PAR << 6+PAD&K'77'
              DQS_RCAR = CAD
              DQS_RWCR =- (P_LEN >> 1)
              DQS_RCR = RXGO!EXT BITS
         %RETURN

TYPE SW(LINE OUTPUT):
              !! OUTPUT REQUEST
              %IF TX REPLY # 0 %THEN -> ABORT
              TX REPLY = MID
              OSEG = P_ADDRESS
!              PAR = MAP ABS(OSEG, P_LEN, TX REPLY)
              PAR = RADDR(OSEG>>13)
              %IF PAR = 0 %THEN -> ABORT
              PAR = PAR+(OSEG&K'17700')>>6;  ! ENSURE ACTUAL BLOCK
              EXT BITS = (PAR&K'176000')>>6
              DQS_TCAR = PAR << 6+P_ADDRESS&K'77'
              F = 0
              DQS_TWCR =- ((P_LEN+1) >> 1)
              %IF P_LEN&1 # 0 %START
                 F = K'040000';        ! 8 IN REMAINING BIT FIELD
              %FINISH
              DQS_TCSR = TX GO!F!EXT BITS
         %RETURN

TYPE SW(MODEM STATUS):
      P_TYPE = 0;         ! FOR NOW
      P_LEN = DQS_MCSR
      %RETURN

ABORT:
     PRINTSTRING('DQS FAIL
')
     %CYCLE;  %REPEAT


     %ROUTINE OCTAL(%INTEGER N)
        %INTEGER I
        PRINTSYMBOL((N >> I)&7+'0') %FOR I = 15, -3, 0
     %END
%END
%ENDOFFILE