!**************
!*  DUP11E    *
!*DA:23.FEB.80*
!**************

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


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

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

     %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEG)
     %SYSTEMINTEGERFNSPEC GETID
     %SYSTEMROUTINESPEC LINKIN(%INTEGER SER)
     %SYSTEMINTEGERFNSPEC MAP ABS(%INTEGER ADR, LEN, REQ ID)
     %PERMINTEGERFNSPEC SVC(%INTEGER EP, P0, P1)

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

     %RECORDFORMAT DUP11F(%INTEGER RCS, RDB, TCS, TDB)

     %OWNRECORD (DUP11F) %NAME DUP = 1;    ! SET UP BY PROT ON INITIALISE

      %RECORDFORMAT DESF(%INTEGER PT, %BYTEINTEGER STATE, S1, %C
       %INTEGER MAX LEN, P1, FLAG, SEG, SA, VEC)
      %RECORDFORMAT DES2F(%RECORD (DESF) RX, TX)

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

      %RECORDFORMAT R1F(%INTEGER N)
      %RECORDFORMAT R2F(%RECORD (DES2F) %NAME DES)

      %RECORD (PAR2F) %NAME P2
      %OWNRECORD (DES2F) %NAME DES
      %RECORD (R1F) R1; %RECORD (R2F) %NAME R2

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


     %CONSTINTEGER MARK = K'377'
     %CONSTINTEGER RSET=K'100',DSR=K'1000',DTR=2,RTS=4,CTS=K'20000'
     %CONSTINTEGER DCD=K'10000',RXEN=K'20',TXEN=K'20',DLEN=K'40'
     %CONSTINTEGER PARM = K'101026';         ! MODE=BYTE, NO CRC, SYN=26
     %CONSTINTEGER TSOM = K'400', TEOM = K'1000'

     %OWNINTEGER TX REPLY, RX REPLY

     %ROUTINESPEC OCTAL(%INTEGER N)

      %SWITCH TYPESW(INITIALISE:OUTPUT DONE)


     %OWNINTEGER TYPE, F, CAD, OSEG, I, X
     %OWNINTEGER PAR, MID, PAD

      %OWNINTEGERARRAY RADDR(0:7)

      -> TYPE SW(P_TYPE)

TYPE SW(INITIALISE):
     MID = GET ID
     MAPHWR(3)
     P2 == P
     DUP == 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

      X = SVC(22, 0, 0);          ! MAP TO DUP DESCRIPTOR AREA
      R2 == R1
      R1_N = X&K'77';           ! JUST THE PAGE DISPLACEMENT
      DES == R2_DES
      DES_RX_VEC = K'160000'!(P_ADDRESS&K'17777')
      DES_TX_VEC = DES_RX_VEC
      DUP_RCS = RSET
      DUP_RDB = PARM
      DUP_RCS = DUP_RCS!DTR
      I = 1000
      %CYCLE
         %IF DUP_RCS&DSR # 0 %THEN %EXIT
         I = I-1
         %IF I = 0 %START
            PRINTSTRING("ICL1: WAITING FOR DSR
")
            %EXIT
         %FINISH
      %REPEAT

      %WHILE DUP_RCS&DSR = 0 %CYCLE; %REPEAT

      DUP_RCS = DUP_RCS!RTS
      I = 1000
      %CYCLE
         %IF DUP_RCS&CTS # 0 %THEN %EXIT
         I = I-1
         %IF I = 0 %START
            PRINTSTRING("ICL1: WAITING FOR CTS
")
            %EXIT
         %FINISH
      %REPEAT
      %WHILE DUP_RCS&CTS = 0 %CYCLE; %REPEAT

      I = 1000
      %CYCLE
         %IF DUP_RCS&DCD # 0 %THEN %EXIT
         I = I-1
         %IF I = 0 %START
            PRINTSTRING("ICL1: WAITING FOR DCD
")
            %EXIT
         %FINISH
      %REPEAT

      %WHILE DUP_RCS&DCD = 0 %CYCLE; %REPEAT
      DUP_RCS = DUP_RCS!RXEN!K'100'
      PRINTSTRING("DU11 INITIALISED
")

      %RETURN

TYPE SW(OUTPUT DONE):
                                       ! TRANSMITTER
              TYPE = LINE OUTPUT
              %IF DES_TX_FLAG < 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 RXREPLY = 0 %START
                 PRINTSTRING("RX: UNWANTED INT
")
              %FINISH
              X = DES_RX_FLAG
              %IF X < 0 %OR RX REPLY = 0 %START
                 F = X;          ! LOWER LEVEL INFORMS TYPE
              %ELSE
                 F = DES_RX_PT-CAD 
                                       ! NUMBER OF BYTES TRANS
                  %IF F> 2000 %START
                      PRINTSTRING("DUP NASTY:")
                      OCTAL(DUP_RCS); 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 %START
                 PRINTSTRING("ICL1: *** ILLEGAL READ REQUEST ***
")
                 %RETURN
              %FINISH
              RXREPLY = MID
              PAD = P_ADDRESS
!              PAR = MAP ABS(PAD, P_LEN, RXREPLY)
              PAR = RADDR(PAD>>13)
              %IF PAR = 0 %START
                 PRINTSTRING("ICL1: *** BAD READ ADDRESS ")
                 OCTAL(PAD); NEWLINE
                 -> ABORT
             %FINISH
              CAD = PAD&K'17777'!K'140000';   ! IN SEG NO 6
              DES_RX_MAX LEN = P_LEN
              DES_RX_SEG = PAR
              DES_RX_PT = CAD
             DUP_RCS = DUP_RCS&(\(RXEN!K'100'))
             DUP_RCS = DUP_RCS!RXEN!K'100'
         %RETURN

TYPE SW(LINE OUTPUT):
              !! OUTPUT REQUEST
              %IF TX REPLY # 0 %START
                 PRINTSTRING("ICL1: *** ILLEGAL WRITE REQUEST ***
")
                 %RETURN
              %FINISH
              TX REPLY = MID
              OSEG = P_ADDRESS
!              PAR = MAP ABS(OSEG, P_LEN, TX REPLY)
              PAR = RADDR(OSEG>>13)
              %IF PAR = 0 %START
                 PRINTSTRING("ICL1: *** BAD WRITE ADDRESS:")
                 OCTAL(OSEG); NEWLINE
                 -> ABORT
              %FINISH
              DES_TX_SEG = PAR
              DES_TX_PT = P_ADDRESS&K'17777'!K'140000';  ! IN SEG NO 6
               DES_TX_SA = P_LEN;     ! LENGHT IN CHARS
               DES_TX_STATE = 1;           ! TELL IT TO EXPECT INTS
               DUP_TCS = DUP_TCS!TXEN
               DES_TX_P1 = 7;               ! STUFF PAD COUNTER
               DUP_TDB = MARK+TSOM;        ! PLANT CHAR
               DUP_TCS = DUP_TCS!K'100';     ! NOW ALLOW INTS
         %RETURN

ABORT:
     PRINTSTRING('ICL1:DUP FAIL    -  ***** DISASTER ******
')
     %CYCLE;  %REPEAT


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