!**************
!*  DUPXXE    *
!*DA:10.JUN.80*
!**************

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


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

%EXTERNALROUTINE DU11E(%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, %C
       %INTEGER LEN, FLAG)

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

      %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'036062';         ! 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

      %OWNINTEGER LINE NO = -1
      %OWNINTEGERARRAY RADDR(0:7)

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

      -> TYPE SW(P_TYPE)

TYPE SW(INITIALISE):
      P2 == P
      LINE NO = P2_FLAG
     MID = GET ID
     MAPHWR(3)
     P2 == P

      X = SVC(22, 5, 0);          ! MAP TO DUP DESCRIPTOR AREA
      R2 == R1
      R1_N = X&K'77'!K'120000';           ! JUST THE PAGE DISPLACEMENT
      DESA == R2_DES
      DES == DESA(LINE NO);             ! MUST MAP TO 'THIS' DESCRIPTOR
      DUP == P2_ADDRESS
      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
            TELL; PRINTSTRING(" 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
            TELL; PRINTSTRING(" 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
            TELL; PRINTSTRING(" WAITING FOR DCD
")
            %EXIT
         %FINISH
      %REPEAT

      %WHILE DUP_RCS&DCD = 0 %CYCLE; %REPEAT
      DUP_RCS = DUP_RCS!RXEN!K'100'
      TELL; PRINTSTRING("DUP Initialised
")

      %RETURN

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

TYPE SW(INPUT HERE):
              !! RECEIVER INTERRUPT
              DUP_RCS = DUP_RCS&(\K'120'); ! CLEAR RXEN
              %IF RXREPLY = 0 %START
                 TELL; PRINTSTRING("RX: UNWANTED INT
")
              %FINISH
              X = DES_RX_FLAG; P_FLAG = X
              %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
                      TELL; 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
                 TELL; PRINTSTRING(" *** 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
                 TELL; PRINTSTRING(" *** 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!K'120';  ! INTS AND RXEN
         %RETURN

TYPE SW(LINE OUTPUT):
              !! OUTPUT REQUEST
              %IF TX REPLY # 0 %START
                 TELL; PRINTSTRING(" *** 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
                 TELL; PRINTSTRING(" *** 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:
     TELL; PRINTSTRING('DUP FAIL    -  ***** DISASTER ******
')
     %CYCLE;  %REPEAT


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