! FILE 'FEP_PARR1E'
!**************
!*  PAR11E    *
!*DA:12.FEB.80*
!**************

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


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

%EXTERNALROUTINE PAR11E(%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 PARRF(%INTEGER RCSR, RBC, RBA, RVEC, %C
        TCSR, TBC, TBA, TVEC)

     %OWNRECORD (PARRF) %NAME PA = 1;    ! SET UP BY PROT ON INITIALISE

      %RECORDFORMAT PAR2F(%INTEGER TYPE, %RECORD (PARRF) %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



     %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
     PA == P2_ADDRESS
     %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(MODEM STATUS):
      P_LEN = K'460'
      %RETURN


TYPE SW(OUTPUT DONE):
                                       ! TRANSMITTER
              TYPE = LINE OUTPUT
               %IF PA_TCSR < 0 %START;  ! ERROR
                 !! 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
           F = PA_RBC+252
           %IF PA_RCSR < 0 %OR F = 0 %START
                 F = -2;          ! FRAME ERROR
              %ELSE
            %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'
               PA_RBC = -252
               PA_RCSR = EXT BITS
               PA_RBA = CAD;            ! EXT BITS ********************
         PA_RCSR = PA_RCSR!K'100'
         %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
              F = 0
         PA_TBC = -(P_LEN);       ! +1 ??   LENGTH
              PA_TCSR = EXT BITS
              PA_TBA = PAR << 6+OSEG&K'77'
               !! NB: EXT BITS ***************************************
           PA_TCSR = PA_TCSR!K'100'
         %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