! FILE 'UMC1E'
! FILE 'FEP_UMC1E'
!**************
!*  UMC1E     *
!*DA:09.JUL.81*
!**************

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


%PERMROUTINESPEC SVC(%INTEGER EP, R0, R1)
%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 UMC11F(%INTEGER CSR, %INTEGERARRAY SPARE(0:6), BIT(0:3), %C
        %BYTEINTEGE.
      %RECORDFORMAT PARMF(%BYTEINTEGER ERR, EXT, %INTEGER ADDR, LEN)
      %OWNRECORD (PARMF) IPAR, OPAR;         ! ONE FOR EACH CHANNEL

      %RECORDFORMAT CONF(%BYTEINTEGER INT VECT, EXT, %INTEGER PARM ADDR)
      %RECORD (CONF) %NAME CON
      %OWNRECORD (CONF) %ARRAY CONA(0:31);          ! WILL GO IN INITIALISE

      %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):
      SVC(18, 1, 0)
     MID = GET ID
     %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

     MAPHWR(0)
     P2 == P
!     P_ADDRESS = P_ADDRESS&K'17777'; ! ENSURE ADDRESS IN SEG 0

      ! FIRST, THE ADDRESS OF I PAR AND O PAR MUST BE PUT IN CONA
      P2_ADDRESS == I PAR
      CAD = P_ADDRESS&K'17777';  ! DISP IN SEGMENT - BETTER BE SEG 6 !
      CON == CONA(0)
      CON_INT VECT = K'360'>>2
      CON_EXT = RADDR(6)>>10
      CON_PARM ADDR = RADDR(6)<<6+CAD

      P2_ADDRESS == O PAR
      CAD = P_ADDRESS&K'17777'
      CON == CONA(1)
      CON_INT VECT = K'364'>>2
      CON_EXT = RADDR(6)>>10
      CON_PARM ADDR = RADDR(6)<<6+CAD

      ! SECOND, THE ADDRESS OF CONA(0) MUST BE PUT IN UMC
      P2_ADDRESS == CONA(0)
      CAD = P_ADDRESS&K'17777'
      UMC_EXT = RADDR(6)>>10;    ! ADDR OF CONA
      UMC_ADDR = RADDR(6)<<6+CAD   ;    !   DITTO
      UMC_LEN = 4*32; ! LENGTH OF SAME

      UMC_FN = 1;                       ! TELL UMC TO TRANSFER
      %WHILE UMC_FN#0 %CYCLE; %REPEAT;  ! WAIT FOR IT
      RX REPLY = 0; TX REPLY = 0
      SVC(18, 2, 0)
      %RETURN

TYPE SW(OUTPUT DONE):
                                       ! TRANSMITTER
              TYPE = LINE OUTPUT
              %IF O PAR_ERR # 0 %OR TXREPLY = 0 %START
                 !! TRANSMITTER ERROR
                 PRINTSTRING("TX ERROR"); WRITE(O PAR_ERR, 1)
                 WRITE(TX REPLY, 1); NEWLINE
                 P_LEN = 1
              %ELSE
                 P_LEN = 0
              %FINISH
            P_TYPE = LINE OUTPUT
              TXREPLY = 0
              %RETURN

TYPE SW(INPUT HERE):
              !! RECEIVER INTERRUPT
              %IF I PAR_ERR # 0 %OR RX REPLY = 0 %START
                 F = -2;          ! FRAME ERROR
                  PRINTSTRING("RX ERROR"); WRITE(I PAR_ERR, 1)
                  WRITE(RX REPLY, 1); NEWLINE
              %ELSE
                 F = I PAR_LEN-2;                   ! NUMBER OF BYTES TRANS
                  %IF F> 252 %START
                      PRINTSTRING("UMC NASTY:")
    5               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')>>10
              I PAR_EXT = EXT BITS
              CAD = PAR << 6+PAD&K'77'
              I PAR_ADDR = CAD
              I PAR_LEN = P_LEN
              I = 1
              UMC_BIT(0) = UMC_BIT(0)!!I;    ! CHANNEL 1 (IE RX ON LINE 0)
         %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')>>10
              O PAR_EXT = EXT BITS
              O PAR_ADDR = PAR << 6+P_ADDRESS&K'77'
              F = 0
              O PAR_LEN = P_LEN
              I = 2
              UMC_BIT(0) = UMC_BIT(0)!!I
         %RETURN

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

ABORT:
     PRINTSTRING("UMC FAIL
")
     %CYCLE;  %REPEAT


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