! RING PROTOCOL TEST PROGRAM. RPTS/RPT.
! A.L. IBBETSON JULY 1979. UNIKENT.
!
! PROVIDES FACILITIES FOR CHECKING BYTE STREAM PROTOCOL
! HANDLING ON ANOTHER DEVICE ON THE CAMBRIDGE RING
!
%CONTROL K'100001'
%BEGIN
%RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY, %INTEGER A1,A2,A3)
%RECORDFORMAT PRF(%BYTEINTEGER SERVICE,REPLY,%C
                   ERROR,STATUS, %INTEGER LEN,A3)
%RECORDFORMAT PTF(%BYTEINTEGER SERVICE,REPLY, %INTEGER ACTION,%C
                   LEN, %BYTEINTEGERARRAYNAME BUF)
!
%CONSTBYTEINTEGERNAME MYID = K'160030'  ;! MY TASK NUMBER
%CONSTBYTEINTEGERNAME INT = K'160060'   ;! FIXED LOC FOR INT FACILITY
%CONSTINTEGER FIVE SECS = 250, TWO SECS = 100
!
! MANIFESTS FOR COMMUNICATION WITH RING DRIVER TASK (SEE RINGRS)
!
%CONSTBYTEINTEGER RING SER     = 29 ;! SERVICE NUMBER
!
%CONSTINTEGER SET ADDRESS  = 1  ;! P_A1 SETTINGS (= ACTION)
%CONSTINTEGER INPT         = 2
%CONSTINTEGER OUTPT        = 3
%CONSTINTEGER RESET        = 4
%CONSTINTEGER OPEN         = 5
%CONSTINTEGER CLOSE        = 6
%CONSTINTEGER KILL         = 7  ;! TELLS RINGRS (RXR) TO DELETE ITSELF
%CONSTINTEGER DIAG         = 8
%CONSTINTEGER REOUTPT      = 9  ;! LAST O/P P_A2 TIMES
%CONSTINTEGER NULL         = 0  ;! JUST TELL ME I/O STATUS
!
%CONSTBYTEINTEGER DATA     = 2  ;! PREPLY_STATUS SETTINGS
%CONSTBYTEINTEGER READY    = 4
%CONSTBYTEINTEGER STOP     = K'200' ;! RXR/TXR HAS HAD A DISASTER
!
%CONSTBYTEINTEGER BEENRESET = K'100' ;!  SPECIAL PREPLY_ERROR SETTINGS
%CONSTBYTEINTEGER BEENCLOSED = K'20'
!
%CONSTINTEGER MAX INPUT LENGTH = 16
%CONSTINTEGER MAXOUTPUTLENGTH = 300
%INTEGERARRAY INTBUFFER(0:149) ;! ==BUFFER, BUT WORD ALIGNED FOR RXR
%BYTEINTEGERARRAYNAME BUFFER  ;! FOR RING INPUT & OUTPUT
%STRING (255) IBUFF
%STRING (255) COMSTR
%STRING (255) ELEMENT
%SWITCH COM(0:6)
!
%INTEGER I,OLDSTATUS,BPT,NOPRINTING,PRINTCOUNT,TXCOUNT
!
! PARAMETERS FOR PON/POFF. NOTE SEVERAL NAMES USED FOR SAME RECORD
!
%RECORD (PF) P
%RECORD (PRF) %NAME PREPLY
%RECORD (PTF) %NAME PTRAN
!
%SYSTEMROUTINESPEC ALARM(%INTEGER TICKS)
%ROUTINESPEC MAP INTBUFFERTOBUFFER
%ROUTINESPEC CALL LOADER(%STRING(255) S)
%ROUTINESPEC RING MESSAGE(%RECORD (PF) %NAME P)
%ROUTINESPEC DUMP P (%RECORD (PF) %NAME P)
%ROUTINESPEC WRITE HEX (%INTEGER X)
%ROUTINESPEC WRITE HEX BYTE (%BYTEINTEGER X)
%ROUTINESPEC PRINTUP(%BYTEINTEGERARRAYNAME B, %INTEGER L)
%ROUTINESPEC INTERPRET(%BYTEINTEGER E,S)
%ROUTINESPEC READ AS STRING (%STRINGNAME S)
%INTEGERFNSPEC READ HEX
%INTEGERFNSPEC COMMAND(%STRING(255) S)
%INTEGERFNSPEC IFROMS(%STRING(255) S)
%INTEGERFNSPEC IFROMHEX(%STRING(255) S)
%INTEGERFNSPEC SPLIT(%STRINGNAME I,C,%STRING(255) S,%STRINGNAME I1)
!
!******************** MAIN PROGRAM CODE **********************
!
PRINTSTRING("RING PROTOCOL TESTER")
NEWLINE
CALL LOADER("TXR") ;! LOAD RING DRIVERS
PRINTSTRING("LOADING DRIVERS"); NEWLINE
ALARM(TWO SECS); P_SERVICE=0; POFF(P)
CALL LOADER("RXR") ;! SEE RINGRS/RINGTS
ALARM(TWO SECS); P_SERVICE=0; POFF(P)
PRINTSTRING("DESTINATION STATION ADDRESS?"); NEWLINE
PROMPT("HEX> "); P_A2 = READ HEX
!
! TELL RING DRIVER WHICH DEVICE TO LISTEN FOR
!
P_SERVICE = RING SER
P_REPLY = MY ID
P_A1 = SET ADDRESS
PON(P)
P_SERVICE = 0; POFF(P)
!
%IF P_REPLY # RING SER %OR (P_A1 & 255) # 0 %START
   PRINTSTRING("DUD INITIAL POFF REPLY: "); DUMP P(P)
   %STOP
%FINISH
!
! RXR WILL LISTEN FOR OPEN FROM GIVEN DEV ADD. IF USER WANTS
! TO DO THE OPEN HE MUST USE THE INT FACILITY TO GET INTO
! COMMAND MODE
!
PREPLY == P; PTRAN == P;   ! THESE ARE ALL THE SAME
PREPLY_STATUS = 0   ;! SO GET STATUS 1ST
MAP INTBUFFER TO BUFFER
OLDSTATUS = 0
INT = 0
NOPRINTING=0 ; PRINTCOUNT=0
TXCOUNT = 0
!
! MAIN LOOP. WHILE DATA AVAILABLE ACCEPT IT & PRINT ON TTY.
! THEN IF OTHER END 'READY' GET A LINE FROM TTY, DECODE
! COMMAND IF PRESENT, & SEND REST OF LINE TO OTHER END.
! ELSE GET STATUS. REPEAT.
!
%CYCLE        ;! UNTIL FATAL ERROR OR K COMMAND
!
   %IF INT # 0 %THEN -> DOINT ;! OPS BREAKING IN
!
   %IF PREPLY_STATUS = STOP %THENSTOP ;! RING DRIVER GONE FATAL
!
! CHECK FOR DATA WAITING FOR ME (THE TXFR HAS BEEN BUFFERED INTERNALLY
! BY RXR)
!
   %IF (PREPLY_STATUS & DATA) # 0 %START
      PTRAN_ACTION = INPT
      PTRAN_BUF == BUFFER
      PTRAN_LEN = MAX INPUT LENGTH
      RING MESSAGE(P) ;! ASK RXR PUT INPUT IN BUFFER
!
      %IF PREPLY_ERROR # 0 %START
         PRINTSTRING("RING INPUT ERROR ")
         NEWLINE
         INTERPRET(PREPLY_ERROR,PREPLY_STATUS)
      %FINISH
!
      %IF PREPLY_LEN > 0 %START
         %IF NOPRINTING=0 %THEN PRINTUP(BUFFER,PREPLY_LEN) %C
         %ELSE PRINTCOUNT = PRINTCOUNT + PREPLY_LEN
      %FINISH
      %CONTINUE ;! SO CAN TAKE MULTIPLE DATA
   %FINISH  ;! DATA WAITING
!
! CHECK FOR OTHER END READY FOR INPUT, OR FOR FORCED COMMAND
! MODE VIA INT
!
   %IF (PREPLY_STATUS & READY) # 0 %START
DOINT:
      %IF INT # 0 %START
         INT = 0
         PRINTSYMBOL('I')
         TXCOUNT = 0
      %FINISH
!
! IF NOT PRINTING OUTPUT ('N' COMMAND), TELL OPS NR BYTES RX
!
      %IF PRINTCOUNT > 0 %START
         WRITE(PRINTCOUNT,1)
         PRINTSTRING(" BYTES RECEIVED"); NEWLINE
         PRINTCOUNT = 0
      %FINISH
!
      PROMPT(">"); READ AS STRING(IBUFF); ! INPUT FROM TTY
      %IF LENGTH(IBUFF)<2 %THEN -> GETSTAT ;! NULL/ILLEGAL INPUT
      TXCOUNT = 1
!
      %IF CHARNO(IBUFF,1) = '#' %START; ! COMMAND LIES BETWEEN # AND SPACE
         IBUFF = FROMSTRING(IBUFF,2,LENGTH(IBUFF))
        %UNLESS SPLIT(IBUFF,COMSTR," ",IBUFF) = 0 %START
            PRINTSTRING("COMMAND MISSING");NEWLINE
            %CONTINUE  ;! MAIN LOOP
         %FINISH
!
         I = COMMAND(COMSTR);  ! DECODE THE COMMAND
         -> COM(I)
COM(0):
COMERR:  TXCOUNT = 0
         %CONTINUE  ;! UNRECOGNISED COMMAND
COM(1):  PTRAN_ACTION = RESET ;! 'R'
         -> TX
COM(2):  PTRAN_ACTION = OPEN  ;! 'O'
         COMSTR = FROMSTRING(COMSTR,2,LENGTH(COMSTR))
         P_A2 = IFROMHEX(COMSTR) ;! FUNCTION CODE
         -> TX
COM(3):  PTRAN_ACTION = CLOSE ;! 'C'
         -> TX
COM(4):  PTRAN_ACTION = KILL  ;! 'K'
         PTRAN_SERVICE = RING SER
         PTRAN_REPLY = 0  ;! NO REPLY
         PON(PTRAN)
         %STOP
COM(5):  PTRAN_ACTION = DIAG; ! 'D'
         -> TX
COM(6):  COMSTR = FROMSTRING(COMSTR,2,LENGTH(COMSTR))
         TXCOUNT = IFROMS(COMSTR) ;! '*<N>' REPEAT N TIMES
      %FINISH;   ! COMMAND DECODE
!
! IBUFF CONTAINS USERS INPUT FOR TRANSFER TO OTHER DEVICE. FORMAT
! IS EITHER HEX DIGIT PAIRS, OR CHARS ENCLOSED IN DOUBLE BLIPS.
! TURN IT INTO BINARY & PLACE IN BUFFER
!
      BPT = 0  ;! NEXT POS IN BUFFER
      %CYCLE
        %IF SPLIT(IBUFF,ELEMENT," ",IBUFF) = 0 %START
            %IF LENGTH(ELEMENT)<1 %START
FERR1:         PRINTSTRING("FORMAT ERROR"); NEWLINE
               -> COMERR
            %FINISH
!
             %IF CHARNO(ELEMENT,1) = '"' %START ;! LITERAL CHS
               -> FERR1 %IF CHARNO(ELEMENT,LENGTH(ELEMENT)) # '"'
               -> FERR1 %IF (LENGTH(ELEMENT)-1+BPT) > MAX OUTPUT LENGTH
               %CYCLE I=2,1,LENGTH(ELEMENT)-1
                  BUFFER(BPT) = CHARNO(ELEMENT,I)
                  BPT = BPT + 1
               %REPEAT
!
            %FINISHELSESTART
               %IF ELEMENT=">" %START ;! CONTINUATION REQ
                  PROMPT("C>"); READ AS STRING(IBUFF)
                  %CONTINUE
               %FINISH
               -> FERR1 %IF LENGTH(ELEMENT) # 2 %ORC
                   BPT >= MAX OUTPUT LENGTH
               BUFFER(BPT) = IFROMHEX(ELEMENT)
               BPT = BPT + 1
            %FINISH
!
         %FINISHELSEEXIT ;  ! END OF LINE
      %REPEAT
!
! BUFFER FILLED WITH BPT BYTES. SEND IT
!
      PTRAN_BUF == BUFFER
      PTRAN_LEN = BPT
      PTRAN_ACTION = OUTPT
!
TX:
      RING MESSAGE (P)
      %IF PREPLY_ERROR # 0 %START
         PRINTSTRING("RING OUTPUT ERROR ")
         NEWLINE
         INTERPRET(PREPLY_ERROR,PREPLY_STATUS)
      %ELSE ;! GONE OK. GOT A '*' COMMAND?
         TXCOUNT = TXCOUNT - 1
         %IF TXCOUNT > 0 %START
            PTRAN_ACTION = REOUTPT
            P_A2 = TXCOUNT
            RING MESSAGE(P)
            %IF PREPLY_ERROR # 0 %THEN INTERPRET(PREPLY_ERROR,PREPLY_STATUS)
         %FINISH
         %CONTINUE
      %FINISH
   %FINISH;   ! READY
!
! NOT READY & NO DATA, OR ERROR. GET STATUS AGAIN
!
GET STAT:
   PTRAN_ACTION = NULL
   PTRAN_LEN = 0
   RING MESSAGE (P)
   %IF PREPLY_ERROR # 0 %THEN INTERPRET(PREPLY_ERROR,PREPLY_STATUS)
!
   %IF (PREPLY_STATUS & (\(DATA+READY))) # OLDSTATUS %START
      OLDSTATUS = PREPLY_STATUS & (\(DATA+READY))
      %IF (OLDSTATUS & 1) # 0 %START
         PRINTSTRING("OPEN COMPLETED OK")
         NEWLINE
      %FINISH
   %FINISH
!
%REPEAT;   ! MAIN LOOP
!
!***************** END OF MAIN PROGRAM CODE *****************
!
!
! THIS RTN FRIGS BUFFER TO BE SAME AS INTBUFFER.
! DECLARED AS INTARRAY COS RXR WILL USE AS SUCH & THUS
! MUST BE WORD ALIGNED
!
%ROUTINE MAP INTBUFFER TO BUFFER
%RECORDFORMAT I(%INTEGERARRAYNAME A)
%RECORDFORMAT J(%BYTEINTEGERARRAYNAME A)
%RECORD (I) X
%RECORD (J) %NAME Y
X_A == INTBUFFER
Y == X
BUFFER == Y_A
%END
!
!
!
%ROUTINE CALL LOADER(%STRING(255) S)
%CONSTINTEGER LOAD SER = 5
%RECORDFORMAT PE(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%C
                %STRINGNAME B, %INTEGER C)
%RECORDFORMAT P1F (%BYTEINTEGER S,R,%INTEGER A,B,C)
%RECORD (PE) P
%RECORD (P1F) %NAME P1
P1 == P
S = S.TOSTRING(NL)
P_B == S
P1_B = P1_B + 1 ;! POINT PAST LENGTH BYTE
!
! P_B NOW POINTS TO WHAT LOOKS LIKE AN I/P BUFFER
!
P_A1 = 1  ;! REQUEST TO LOAD
P_C = 0 ;! NORMAL LOAD (???)
P_SERVICE = LOAD SER
P_REPLY = MY ID
PON(P)
%END
!
!
%ROUTINE RING MESSAGE (%RECORD (PF) %NAME P)
P_SERVICE = RING SER
P_REPLY = MY ID
PON(P)
REPOFF:
P_SERVICE = 0
POFF(P)
%IF P_SERVICE # MY ID %OR  P_REPLY # RING SER %START
   PRINTSTRING("UNEXPECTED POFF ")
   DUMP P (P)
   -> RE POFF
%FINISH
%END
!
!
%ROUTINE INTERPRET(%BYTEINTEGER ERROR,STATUS)
PRINTSTRING("ERR = ");WRITEHEXBYTE(ERROR)
PRINTSTRING(" STAT = ");WRITEHEXBYTE(STATUS)
%IF (ERROR & 1) # 0 %THEN PRINTSTRING(" IN WRONG STATE TO DO OPEN")
%IF (ERROR & 8) # 0 %THEN PRINTSTRING(" ILLEGAL BUFFER LENGTH")
%IF (ERROR & K'20') # 0 %THEN PRINTSTRING(" BEEN CLOSED")
%IF (ERROR & K'40') # 0 %THEN PRINTSTRING(" REC DUD OPEN/ACK")
%IF (ERROR & K'100') # 0 %THEN PRINTSTRING(" BEEN RESET")
%IF (ERROR & K'200') # 0 %THEN PRINTSTRING(" REC T-OUT/CHECKSUM/NOT IN BSP MODE")
NEWLINE
%END
!
!
%ROUTINE READ AS STRING (%STRINGNAME S)
%INTEGER I
S = ""
%CYCLE
   READ SYMBOL(I)
   %EXITIF I=10  ;! NL
   S = S.TOSTRING(I) %IF I>31 ;! IGNORE NONPRINTERS
%REPEAT
S = S." " ;! BODGE FOR COMMAND HANDLER
%END
!
!
%INTEGERFN READ HEX
%STRING(255) S
READ AS STRING (S)
%RESULT = IFROMHEX (S)
%END
!
!
%INTEGERFN COMMAND(%STRING(255) S)
%INTEGER I
-> IC %IF S=""
I = CHARNO(S,1)
%RESULT = 1 %IF I = 'R'
%RESULT = 2 %IF I = 'O'
%RESULT = 3 %IF I = 'C'
%RESULT = 4 %IF I = 'K'
%RESULT = 5 %IF I = 'D'
%RESULT = 6 %IF I = '*'
%IF I='N' %THEN NOPRINTING=1 %ANDRESULT = 0
%IF I='P' %THEN NOPRINTING=0 %ANDRESULT = 0
IC:
PRINTSTRING("ILLEGAL COMMAND"); NEWLINE
%RESULT = 0
%END
!
!
%ROUTINE DUMP P (%RECORD (PF) %NAME P)
PRINTSTRING(" S="); WRITE HEX BYTE(P_SERVICE)
PRINTSTRING(" R="); WRITE HEX BYTE(P_REPLY)
PRINTSTRING(" A1="); WRITEHEX(P_A1)
PRINTSTRING(" A2="); WRITEHEX(P_A2)
PRINTSTRING(" A3="); WRITEHEX(P_A3)
NEWLINE
%END
!
%ROUTINE WRITE HEX (%INTEGER X)
%BYTEINTEGER Y
Y = X>>8
WRITE HEX BYTE (Y)
Y = X & 255
WRITE HEX BYTE (Y)
%END
!
!
!
%ROUTINE WRITE HEX BYTE (%BYTEINTEGER X)
%ROUTINE NIBBLE(%BYTEINTEGER N)
%INTEGER P
N = N & 15
%IF N>9 %THEN P = N-10+'A' %C
%ELSE P = N+'0'
PRINTSYMBOL(P)
%END
NIBBLE(X>>4)
NIBBLE(X)
%END
!
!
%ROUTINE PRINTUP(%BYTEINTEGERARRAYNAME B, %INTEGER L);! L<=16
%INTEGER I
%CYCLE I=0,1,L-1
   WRITEHEXBYTE(B(I))
   PRINTSYMBOL('/')
   %IF 'Z'>=B(I)>=' ' %THEN PRINTSYMBOL(B(I)) %ELSE SPACE
   SPACE
%REPEAT
NEWLINE
%END
!
!
%INTEGERFN IFROMS(%STRING(255) S)
%INTEGER I,N
N=0
%CYCLE I=1,1,LENGTH(S)
   %IF '9'>=CHARNO(S,I)>='0' %THENC
      N = N*10 - '0' + CHARNO(S,I)
%REPEAT
%RESULT = N
%END
!
!
%INTEGERFN I FROM HEX (%STRING(255) S)
%INTEGER I,N,C
N=0
%CYCLE I=1,1,LENGTH(S)
   C = CHARNO(S,I)
   %UNLESS '9'>=C>='0' %OR 'F'>=C>='A' %THENCONTINUE
   %IF '9'>=C>='0' %THEN C = C-'0' %C
   %ELSE C = C-'A'+10
   N = (N<<4) + C
%REPEAT
%RESULT = N
%END
!
!
! FN ATTEMPTS SOURCE -> BEFORE.(MATCH).AFTER
! RETURNS 0 IF SUCCEEDS.
!
%INTEGERFN SPLIT(%STRINGNAME SOURCE,BEFORE, %STRING(255) MATCH, %C
                   %STRINGNAME AFTER)
%INTEGER I,J,ML,SL,A
!
ML = LENGTH(MATCH); SL = LENGTH(SOURCE)
%IF ML >= SL %THENRESULT = -1 ;! FAIL
!
%CYCLE I=0,1,SL-ML
   A = 0
   %CYCLE J=1,1,ML
      %IF CHARNO(MATCH,J) # CHARNO(SOURCE,I+J) %THENC
         A = 1 %ANDEXIT
   %REPEAT
!
   %IF A = 0 %START ;! FOUND MATCH IN SOURCE
      %IF I>0 %THEN BEFORE = FROMSTRING(SOURCE,1,I) %ELSE BEFORE=""
      %IF I<(SL-ML) %THEN AFTER = FROMSTRING(SOURCE,I+ML+1,SL) %C
      %ELSE AFTER = ""
      %RESULT = 0 ;! SUCCESS
   %FINISH
%REPEAT
%RESULT = -1 ;! FAIL
%END
!
%ENDOFPROGRAM