! RINGTS/TXR. ALI AUG 1979
! DEVICE ROUTINE FOR RING OUTPUT. SEE RPTS & RINGRS
!
%CONTROL K'100001'
%BEGIN
%CONSTBYTEINTEGERNAME MY ID = K'160030'
%CONSTINTEGER TOLIM=5,TXQLIM=7,PKTLIM=1499,PTBLIM=127,%C
   TXRSER=28,TXRDUMPSER=27,TRACESER=26 ;! PON/POFF SERVICE NRS
%RECORDFORMAT TXQF(%INTEGER PKTPOS,COUNT,SEQ,TIMEOUT)
%RECORD (TXQF) %ARRAY TXQ(0:TXQLIM) ;! TX MESSAGES WAITING TXFR OUT
%RECORD (TXQF) %NAME TXQ0
%INTEGERARRAY PKTBUF(0:PKTLIM) ;! HOLD PACKETS 4 ALL TXQ ENTRIES
%INTEGERARRAY PKT TRACE BUF(0:PTBLIM) ;! HISTORY LAST PKTS OUTPUT
!
%RECORDFORMAT PF(%BYTEINTEGER S,R,%INTEGER A1,A2,A3)
%RECORD (PF) P
%RECORDFORMAT PTF(%BYTEINTEGER S,R,%INTEGERARRAYNAME B,%INTEGER C,A)
%RECORD (PTF) %NAME PT
%RECORDFORMAT PRF(%BYTEINTEGER S,R,%INTEGER ERROR,TIMEOUT,SEQ)
%RECORD (PRF) %NAME PR
!
%RECORDFORMAT HDWRF(%INTEGER RBUFF,SOURCE,SELECTOR,STATUS,TBUFF,%C
   DEST,SPARE,INTSTATUS)
%CONSTRECORD (HDWRF) %NAME HDWR = K'104040'
!
%INTEGER I,J,S,TXQPT,CLOCKCOUNT,TIMEOUT,TIMING,ALARMSET,TEMP
%INTEGER PKTBUFSPACE,PKTFILL,PTBPTR,PKT,DEVADD
!
%SYSTEMROUTINESPEC ALARM(%INTEGER TICKS)
%SYSTEMROUTINESPEC LINKIN(%INTEGER TASK)
%SYSTEMROUTINESPEC MAP VIRT(%INTEGER TASK,SEG,MYSEG)
%SYSTEMROUTINESPEC MAP HWR(%INTEGER MYSEG)
!
!
!
! RTN COBBLES PT_B SO BUFFER MAPS TO MY VM
!
%ROUTINE MAP BUFFER
%INTEGER SEG
%CONSTINTEGER MYSEG=5, MYSEGA=K'120000'
SEG = P_A1 >> 13
MAP VIRT(P_R,SEG,MYSEG)
P_A1 = MYSEGA + (P_A1&K'17777')
%END
!
!
!
! DIRTY FN FOR DOING EMT 20
!
!
%INTEGERFN TOFF(%INTEGER TEMP)
*K'010046' ;! STACK R0
*K'104024'
*K'010065';*K'000004'; ! MOV R0,TEMP
*K'012600' ;! UNSTACK R0
%RESULT = TEMP
%END
!
!
!
%ROUTINE WRITEHEX(%INTEGER X)
%INTEGER J,K
%CYCLE J=12,-4,0
   K = (X>>J) & 15
   %IF K>9 %THEN PRINTSYMBOL(K-10+'A') %C
   %ELSE PRINTSYMBOL(K+'0')
%REPEAT
%END
!
!
!
! RTN PRINTS UP TRANSMIT PACKET BACKTRACE
!
%ROUTINE PACKET BACKTRACE
%INTEGER I,L,P
L=0
PRINTSTRING("MOST RECENTLY TRANSMITTED PACKETS:-"); NEWLINE
%CYCLE I=0,1,PTBLIM
   L = (L+1) & 15
   P = PKT TRACE BUF(PTBPTR) ;! SEE FN NEXTPKT
   WRITEHEX(P)
   PTBPTR = PTBPTR + 1
   %IF PTBPTR > PTBLIM %THEN PTBPTR = 0
   SPACE
   %IF L=0 %THEN NEWLINE
%REPEAT
NEWLINE
%END
!
!
!
! RTN STARTS TIMING OUT SEQUENCE. A MESSAGE
! MUST BE ACCEPTED WITHIN 500 MSEC OR IT IS
! ABANDONED.
!
%ROUTINE SET TIMER
CLOCKCOUNT = 0
TIMING = 1
TIMEOUT = 0
%IF ALARMSET = 0 %START
   ALARMSET = 1
   ALARM(5) ;! 100 MSEC
%FINISH
%END
!
!
!
! FN RETURNS NEXT PACKET TO BE SENT. NB UPDATE OF
! P1. MAINTAINS HISTORY OF PACKETS I HAVE ATTEMPTED
! TO SEND (THO MAY BE REJECTED BY DESTINATION)
!
%INTEGERFN NEXT PKT(%INTEGERNAME PKTPOS)
%INTEGER PKT
PKT = PKTBUF(PKTPOS)
PKTPOS = PKTPOS+1
%IF PKTPOS > PKTLIM %THEN PKTPOS=0
PKT TRACE BUF(PTBPTR) = PKT ;! HISTORY
PTBPTR = PTBPTR + 1
%IF PTBPTR > PTBLIM %THEN PTBPTR = 0
PKTBUFSPACE = PKTBUFSPACE + 1 ;! FREE FOR NEW MESSAGES
%RESULT = PKT
%END
!
!
!
! RTN ACTIONS MESSAGE IN P. IF IT'S A TXFR REQUEST & I
! HAVEN'T ENOUGH SPACE TO BUFFER IT, THEN THE MESSAGE
! IS RE-PONNED.
!
%ROUTINE DO MESSAGE
%INTEGER I
%OWNINTEGER FIRST=1
%INTEGERARRAYNAME BUF
%RECORD (TXQF) %NAME TXQR
!
%IF P_S=MYID %AND P_R=0 %START ;! CLOCK INTERRUPT
   %IF TIMING=0 %THEN ALARMSET=0 %ELSESTART
      CLOCKCOUNT = CLOCKCOUNT+1
      %IF CLOCKCOUNT > TOLIM %START ;! 500 MSEC
         ALARMSET = 0
         TIMEOUT = 1
      %ELSE
         ALARM(5) ;! 100 MSEC
      %FINISH
   %FINISH
   %RETURN
%FINISH
!
%IF P_S=TXR SER %START ;! TXFR REQUEST FROM RINGRS/RXR (QV)
   %IF PT_C > PKTBUFSPACE %OR TXQPT=TXQLIM %THEN PON(P) %ANDRETURN
   TXQPT = TXQPT + 1 ;! NEXT POSN ON QUEUE
   TXQR == TXQ(TXQPT) ;! JUST 4 SPEED
   TXQR_PKTPOS = PKTFILL ;! START POS IN BUFFER
   TXQR_COUNT = PT_C
   %IF FIRST # 0 %START
      FIRST = 0
      DEVADD = PT_A ;! RING STATION ADDRESS TO SEND TO
      TXQR_SEQ = 0 ;! INTERNAL SEQUENCE NR
   %ELSE
      TXQR_SEQ = PT_A ;! FOR TRACING ON FATAL ERROR IN RINGRS
   %FINISH
   TXQR_TIMEOUT = 0
   MAP BUFFER
   BUF == PT_B
   %CYCLE I=0,1,PT_C-1 ;! COPY TXFR INTO MY BUFFER
      PKTBUF(PKTFILL) = BUF(I)
      PKTFILL = PKTFILL + 1
      %IF PKTFILL > PKTLIM %THEN PKTFILL=0
   %REPEAT
   PKTBUFSPACE = PKTBUFSPACE - PT_C
   P_S = P_R
   P_R = TXR SER
   PON(P) ;! TELL HIM HIS BUFFER NOW FREE
   %RETURN
%FINISH
!
%IF P_S=TXR DUMP SER %START ;! WE'RE FINISHING
   %IF P_A1 # 0 %START ;! WANTS A BACKTRACE (FATAL ERROR)
      PACKET BACKTRACE
      P_S = P_R
      P_R = TXR DUMP SER
      PON(P) ;! TELL HIM BACKTRACE COMPLETED
   %FINISH
   %STOP
%FINISH
%END
!
!
!
! RTN CHECKS TO SEE IF ANY MESSAGES WAITING.
! IF YES PROCESSES 1ST ONE ON QUEUE, BUT 4
! SIMPLICITY DOESN'T TRY TO EMPTY QUEUE
!
%ROUTINE CHECK 4 MESSAGE
%IF TOFF(TEMP) # 0 %START
   P_S=0; POFF(P)
   DO MESSAGE
%FINISH
%END
!
!
!
! RTN CALLED WHEN GET DUD BITS UP IN STATUS REGISTER
!
%ROUTINE FATAL(%INTEGER STATUS)
PRINTSTRING("TXR: STATUS ")
WRITEHEX(S); NEWLINE
PR_S = TRACE SER
PR_R = 0
PR_ERROR = 1
PR_TIMEOUT = 1
PR_SEQ = TXQ0_SEQ
PON(PR)
DISCARD:
P_S=0; POFF(P)
%IF P_S # TXR DUMP SER %THEN -> DISCARD
DO MESSAGE ;! & %STOP
%END
!
!
!
! ********************** MAIN PROGRAM **************************
!
LINKIN(TXR SER)
LINKIN(TXR DUMP SER)
TXQPT = -1 ;! TX QUEUE EMPTY
%CYCLE I=0,1,PTBLIM; PKTTRACEBUF(I)=0; %REPEAT
PT==P; PR==P ;! SAME RECORD 4 ALL MESSAGES
PKTBUFSPACE = PKTLIM+1; PKTFILL=0; PTBPTR=0 ;! BUFFERS EMPTY
ALARMSET = 0 ;! NO CLOCK INT PENDING
TXQ0 == TXQ(0) ;! FASTER ACCESS
MAP HWR(4)
!
! MAIN LOOP
!
%CYCLE
   CHECK 4 MESSAGE
   %IF TXQPT >= 0 %START ;! GOT A TXFR BUFFERED
      SET TIMER ;! GOTTA FINISH WITHIN 500 MSEC
      %CYCLE I=1,1,TXQ0_COUNT
         PKT = NEXTPKT(TXQ0_PKTPOS); ! NB UPDATES PKTPOS
RETRY:   %CYCLE J=1,1,16 ;! ATTEMPT TX 16 TIMES B4 CHECK 4 TIMEOUT
            HDWR_DEST = DEV ADD ;! SET ON 1ST TXFR REQUEST
            HDWR_TBUFF = PKT
            %WHILE (HDWR_INTSTATUS & K'200') = 0 %CYCLE ;! DONE?
               %IF (HDWR_INTSTATUS & K'20') = 0 %START
                  PRINTSTRING("TXR: RING SWITCHED OFF"); NEWLINE
                  FATAL(HDWR_INTSTATUS)
               %FINISH
            %REPEAT ;! UNTIL DONE BIT UP
            S = (\(HDWR_STATUS)) & K'37'
            %IF S=4 %THENEXIT ;! ACCEPTED
            %IF (S&K'30') # 0 %THEN FATAL(HDWR_STATUS) ;! IGNORED, DUD
         %REPEAT
         CHECK 4 MESSAGE
         %IF TIMEOUT # 0 %START ;! ABANDON REST OF MESSAGE
            TXQ0_TIMEOUT = 1
            %EXIT
         %FINISH
         %IF S # 4 %THEN -> RETRY ;! BUSY REJECT
      %REPEAT ;! 4 TXQ0_COUNT PACKETS
      TIMING = 0
      PR_S = TRACE SER
      PR_R = 0
      PR_ERROR = 0 ;! 1 ONLY IN RTN FATAL
      PR_TIMEOUT = TXQ0_TIMEOUT
      PR_SEQ = TXQ0_SEQ ;! TRACE SEQUENCE NR
      PON(PR) ;! TO TASK RINGRS/RXR
      %IF TXQPT > 0 %START ;! MORE MESSAGES BUFFERED?
         %CYCLE I=1,1,TXQPT
            TXQ(I-1) = TXQ(I) ;! COLLAPSE QUEUE
         %REPEAT
      %FINISH
      TXQPT = TXQPT - 1
!
   %ELSE ;! NOTHING TO DO
      P_S = 0
      POFF(P) ;! JUST WAIT FOR RXR
      DO MESSAGE
   %FINISH
!
%REPEAT; ! MAIN LOOP
%ENDOFPROGRAM