! file 'ring_bsp78S' ! nb: should be prepped ! !******************************** !* emas-2900 bsp interface * !* handler * !* file: bsp78S * !* date:27.apr.82 * !* modified for ercc use * !********************************* !! stk = 300, strm = 1 ! prep options:- o - old compiler ! n - new compiler ! g - Xgate Vsn, open reply A to sendmessage %constrecord (*) %name nil == 0 #if o %control 1 %include "deimosperm" #else %INCLUDE "b_deimosspecs" %control x'4001' #fi %begin %conststring (9)vsn = "BSP..5q " #datestring %constinteger gateway = 11; !$e %constinteger ring node no = 72 %owninteger datamark=k'123456' %recordformat mef(%record (mef) %name link, %byteinteger len, %c type, %integer address,port,rcomm,tcomm, %c %integerarray a(0:100) ) ! think about the position of ! 'len' !buffer queues %recordformat meqf(%record (mef) %name link); %recordformat pe(%byteinteger ser, reply, fn, port, %c %record (mef) %name mes, %byteinteger len, s1) %recordformat pe2(%byteinteger ser, reply, fn, port, %c %integer lport, hport ); !low nd high port limits %recordformat pe3(%byteinteger ser,reply,fn,port,a,b,c,d) %recordformat qf(%record (mef) %name e) %recordformat r1f(%integer x) %recordformat r2f(%record (mef) %name mes) %recordformat r3f(%byteintegername b) %recordformat r4f(%string(255)name s) !byte stream command codes %constinteger rdy=x'3000' %constinteger notrdy=x'5000' %constinteger reset=x'6300' %constinteger close=x'6600' %constinteger data=x'a000' %constinteger nodata=x'c000' %constinteger closereq=4 !transport service command codes %constinteger open=x'6a00' %constinteger sspreq=x'6c00' %constinteger openack=x'6500' %constinteger longblock=x'9000' %constinteger longblockch=x'9000' %constinteger longblockcs0=x'9400' %constinteger singleshot=x'9800' !flag bits added into data command %constinteger control data=8 %constinteger expedited data=16 %constinteger odd=1 %constinteger push data=2 %constinteger close request=4 !byte stream states %constinteger closed=0; ! %constinteger opening=1; !waiting for open ack %constinteger closing=2; !waiting for close %constinteger idle=3; !byte stream state %constinteger nesent=4; !ditto %constinteger esent=5; !ditto %constinteger openinput=6; !open or send mess has been input %constinteger open mess=7; !waiting for response to send mess ! array to define which bs states are closeable %ownbyteintegerarray closeable(0:open mess)=0,1,0,1,1,1,0,0 %constinteger bslimit=30; !number of byte streams %constinteger bslim2=61; !bslimit*2+1 ! function codes to and from ! ring ser !values below added to function codes %constinteger releaseflag=x'80'; !release buffer after output %constinteger tellflag=x'40'; !notify at end of output %constinteger cs0flag=x'20' %constinteger command mask=x'1f'; !to mask out values above %constinteger enable port=0 %constinteger xdata=1 %constinteger ssout=2; !not used %constinteger xrdy=3 %constinteger xnotrdy=4 %constinteger xnodata=5 %constinteger xclose=6 %constinteger xreset=7 %constinteger xclosereq=8 %constinteger xexprdy=9 %constinteger output trace=16; !force output of ring trace %constinteger r output done=0 %constinteger transfer error=1 %constinteger r input done=2 %constinteger input error=3 %constinteger ring down=4 ! incoming function codes ! ------------------------- %constinteger enablefacility=1 %constinteger disablefacility=2 %constinteger callreply=3 %constinteger enableinput=4 %constinteger putoutput=5 %constinteger closecall=6 %constinteger abortcall=7 %constinteger opencall=8 %constinteger openmessage=9 %constinteger new opencall = 10 ! outgoing function codes ! ----------------------- %constinteger incomingcall=2 %constinteger inputdone=3 %constinteger outputdone=4 %constinteger callclosed=5 %constinteger callaborted=6 %constinteger openreply a=7 %constinteger openreply b=8 %constinteger message r=9 %constinteger message reply=10 %constinteger timeout=2; !number of alarm calls !timeout between 1 and 2 secs. %constinteger faultlimit = 5; !byte stream is closed after !this number of accumulated errors !stream 1 is used only for open/openack transfers !format of records defining the byte streams !each byte stream has 2 bsf records. one for the !receiver and one for the transmitter. all the !bs records are in array bs, the records for port !p are the 2*p (transmitter) and the 2*p+1 (receiver) !elements of the array. %recordformat bsf( %integer tout, destport, %c %record (mef) %name buf, %c %byteinteger state, sequence, dest, reply, %c faultcount, number, closeflag, node, %c rdy command,gah, ufl, sp1, {$ee} %c %record (qf) bufq ); !$e ******** !gah field just used for receiver %constinteger initialgah=1; !no of rdys sent without !input enables %ownrecord (bsf) %array bs(2:bslim2) !info describing input transfer %owninteger isource,iport,ircomm,itcomm %ownrecord (bsf) %name tbsp,rbsp !time is incremented on every alarm call, on overflow to !zero it is set to 1 as time 0 implies time-not-set %owninteger time %constinteger maxfacility=25; !bs function codes %ownbyteintegerarray facility(0:max facility)=0(*) ! facility codes are :- ! 18 = itp %owninteger errors, ttimen, rtimen, retran %integer t,i %record (bsf) %name bsp !************************************************************** !* buffer manager calls (from and to) * !************************************************************** %constinteger buffer here = 0 !********** to buffer manager *********** %constinteger request buffer = 0 %constinteger release buffer = 1 !**************************************************************** !********** various service numbers ************* %constinteger bsp ser = 16 %constinteger ring ser = 13; !$e %constinteger buffer manager = 17 %constinteger time int = 0 %constbyteintegername change out zero == k'160310' %constinteger t3 ser = 21 %constintegername pkts==k'100010' %constintegername sbr==k'100006' %constintegername byt==k'100004' !************************************************************ %record (pe2) %name pp; !points to p below %record (pe3) %name p3; !$e %record (pe3) %name op3; !points to op below %record (pe2) %name op1; !points to op below !%ownrecord (pe) %array ptrace(0:300) !%owninteger ptp=0 %record (pe)p %record (pe) op %owninteger x=0 %ownrecord (mef) %name inbufq %owninteger mon = 0 %record (r1f)r1; %record (r2f) %name r2; %record (r3f) %name r3 %record (r4f) %name r4 ! %routinespec pont(%record (pe) %name p) %routinespec fromabove %integerfnspec findfreeport %routinespec from buffer manager %routinespec from below %routinespec perror(%integer i) %routinespec processinput %routinespec ssinput %routinespec doopenack %routinespec openfailed( %record (bsf) %name bsp, %integer flag) %routinespec error(%integer n,source) %routinespec init p rec(%record (bsf) %name bsp, %c %integer seq,state,tout,reply, %c dest,destport) %routinespec initport( %integer i,dest,destport,reply) %routinespec do i rdy %routinespec doinotrdy %routinespec dodataack %routinespec doidata %routinespec processdata %routinespec doinodata %routinespec ttimedout(%record (bsf) %name bsp) %routinespec rtimedout(%record (bsf) %name bsp) %routinespec send to ring(%integer fn, %record (bsf) %name bsp) %routinespec tsend(%record (bsf) %name bsp) %routinespec initialise %routinespec doreset %routinespec doclose %routinespec down(%record (bsf) %name bsp,%integer type) %routinespec free buffer(%record (mef) %name mef) %routinespec get buffer(%integer port) %routinespec send openack(%record (bsf) %name bsp, %integer suflag) %routinespec fault(%record (bsf) %name bsp) %routinespec forceclose(%integer port, type) %routinespec startclose(%record (bsf) %name bsp) %routinespec finishclose( %integer port) %routinespec clearbsport(%record (bsf) %name bsp) %routinespec send(%record (bsf) %name bsp, %integer fn) %routinespec swaba(%integername p,%integer len) !********************************************** !* initialisation * !********************************************** printstring(vsn) printstring(datestring); newline i = map virt(buffer manager, 5, 4); ! map to my seg 4 i = map virt(buffer manager, 6, 5); !and to seg 5 r2 == r1; r3 == r2; r4 == r3 linkin(bsp ser) #if o change out zero = t3 ser #else use tt(t3 ser) #fi initialise; !initialise data structures !enable ports to ring server op1_fn=enable port op1_ser=ring ser; op1_reply=own id; op1_lport=1; op1_hport=bslimit ! pont(op) pon(op) alarm(100) %cycle p_ser = 0; poff(p) ! clock call %if p_ser = own id %start; %if p_reply=0 %start; !clock call alarm(100) time=time+1 %if time=0 %then time=1; !time=0 => time not set %if 'M' <= int <= 'P' %start mon = int-'O'; int = 0 %finish %if int = '?' %start printstring("errors ="); write(errors, 1) printstring(", t timeout ="); write(ttimen, 1) printstring(", r timeout ="); write(rtimen, 1) printstring(", retransmits ="); write(retran, 1) newline; int = 0 printstring(" Index State Node Term Close? Faults ") %cycle i = 4, 2, bslim2-1 bsp == bs(i) %if bsp_state # closed %start write(bsp_number, 3); write(bsp_state, 5) write(bsp_node, 5); write(bsp_dest, 5) write(bsp_closeflag, 5); write(bsp_faultcount, 5) newline %finish %repeat %finish x=x+1 !look for timeouts %cycle i=4,2,bslim2-1 t=bs(i)_tout %if t#0 %and time-t>timeout %thenc ttimedout(bs(i)) t=bs(i+1)_tout %if t#0 %and time-t>timeout %thenc rtimedout(bs(i+1)) %repeat %else ! pont(p) %if p_reply=ring ser %start from below %else %if p_reply=buffer manager %start from buffer manager %finish %finish %finish %else ! pont(p) %if p_ser = bsp ser %start from above %finish %finish %repeat !miscellaneous routines %routine from above !------------------ !deocde message from higher level protocol software. !p-fn = function code !p_port = byte stream number !p_mes = buffer pointer !p_s1 used on call reply, #0 => ok, =0 => reject open ! also bs function code on enable/disable %integer i,fn,s1,port,l,type %switch fns(enable facility : new open call) fn=p_fn s1=p_s1 port=p_port %if fn > new open call %start perror(1) %return %finish %if mon<0 %start select output(1) printstring("From above, caller =") write(p_reply, 1) printstring("Fn ="); write(fn, 1) printstring(", Port ="); write(port, 1) printstring(", S1 ="); write(s1, 1); newline select output(0) %finish -> fns(fn) fns(enable facility): fns(disable facility): %if s1>max facility %then perror(3) %and %return %if fn=enable facility %then facility(s1)=p_reply %elsec facility(s1)=0 %return fns(call reply): bsp==bs(port<<1); !reply to open %if bsp_state#open input %start printstring("State ="); write(bsp_state, 1); space perror(4); %return %finish %if s1#0 %start; !accepted i=0 %else i=16; !failed %finish !send open ack reply send openack(bsp , i) !if open failed or sendmessage response clear the port %if s1=0 %or s1=128 %then clearbsport(bsp) %and %return initport(port<<1, bsp_reply, bsp_dest, bsp_destport) !run through into enable input case to send rdy fns(enable input): bsp==bs( port<<1+1 ) %if bsp_closeflag#0 %start %return %finish bsp_gah=bsp_gah+1 %if bsp_state#nesent %then %return send to ring( bsp_rdy command, bsp) bsp_state=esent bsp_tout=time %return fns(put output): bsp==bs(port<<1) %if bsp_stateesent %or bsp_closeflag #0 %start freebuffer(p_mes) %return %finish !swab the data part of the buffer l=p_mes_len #if ~d swaba(p_mes_a(0), (l+1)>>1 ) #fi pkts=pkts+1 byt=byt+l>>2 !convert the buffer length to packet count, leaving the odd byte !flag bit in tcomm p_mes_len=(l+3)>>1 p_mes_tcomm=(l&1) %if bsp_state=nesent %start bsp_buf==p_mes tsend(bsp) %else push(bsp_bufq, p_mes); !queue buffer on byte stream %finish %return fns(closecall): bsp==bs(port<<1+1) !see if response to close request %if bsp_closeflag#0 %start; !yes forceclose(port, 0); !send out close %return %finish bsp==bs(port<<1) %if bsp_state # closing %start bsp_closeflag=1 %if bsp_buf==nil %and bsp_state=nesent %then tsend(bsp) %finish %return fns(abort call): forceclose(port, call aborted) %return fns(open message): fns(new open call): port=find free port %if port#0 %start bsp==bs(port<<1) p_mes_a(1) = p_len; !$e extract and move the term address p_len = gateway %if 72 # p_mes_a(2)#0; !$e re-address the packet !$e if off ring destination %if fn = open message %start init p rec(bsp, 0, open mess, (time+10)!1, %c p_reply,p_len, 1); !timeout after 10 secs type = sspreq %else; ! new open call init p rec(bsp, 0, opening, (time+2)!1, %c p_reply, p_len, p_s1) type = open %finish p_mes_address=p_len p_mes_port=1 p_mes_rcomm=type+(p_mes_len & 1) p_mes_tcomm=port p_mes_a(0)=p_s1; !facility number p_mes_len=(p_mes_len+1)>>1+4; !$e convert byte len to bs hdr #if ~d swaba(p_mes_a(3), p_mes_len-4); !$e #else swaba(p_mes_a(0), 3) #fi op_mes==p_mes send to ring(xdata+release flag, bsp) #if g -> do open reply; ! allways do it, so that sendmessages ! can be associated #else %if fn = new open call %then ->do open reply #fi %else freebuffer(p_mes); !no free port %finish %return fns(open call): port=find free port %if port#0 %start !s1 = dest port (facility) !len = destination address bsp==bs(port<<1) bsp_state=opening bsp_reply=p_reply bsp_dest=p_len bsp_node = p3_a; !$e bsp_ufl = 0; ! $ee %if p3_b&x'80' # 0 %then bsp_ufl = p3_b&127; ! $ee !if s1=255 then the facility code is a 16 bit value in !p_lport, s1 is used for byte values for compatibility with old !gate %if s1#255 %start bsp_destport=s1 %else bsp_destport=pp_lport %finish get buffer(port) %finish !reply back up to give port number do open reply: op_ser=p_reply; op_reply=bsp ser op_s1=p_s1; op_fn=open reply a op3_a=port; !return port number op_port=p_port; op_len=p_len ! pont(op) pon(op) %return %end; !from above %integerfn findfreeport !----------------------------- %integer i %cycle i=4,2,bslim2-1 %if bs(i)_state=closed %then %result=i>>1 %repeat %result=0 %end %routine perror(%integer number) !------------------------------- printstring("Bsps:perror -"); write(number,3) write(p_reply,3) write(p_fn,3) write(p_port,3) write(p_len,3) write(p_s1,3) newline %end; !perror %routine from buffer manager !----------------------------- !have now got buffer in which to send an open %record (mef) %name mes %record (bsf) %name bsp bsp==bs(p_port << 1) %if bsp_state#opening %start freebuffer(p_mes) %return %finish mes==p_mes mes_len=4; !$e mes_port=1 mes_rcomm=open mes_tcomm=p_port; !reply port number mes_a(0)=bsp_destport+bsp_ufl<<8; !reqd facility #ee %if bsp_dest = 72 = bsp_node %then bsp_dest = 9 ! maps n72t72 (fe1) -> n72t9 mes_a(1) = bsp_dest; !$e mes_a(2) = bsp_node; !$e bsp_dest = gateway %if 0 # bsp_node # ring node no; !$e - off ring connect mes_address=bsp_dest #if d swaba(p_mes_a(0), 3) #fi op_mes==mes send to ring(xdata+release flag, bsp) bsp_tout=(time+2) ! 1 %end %routine from below !------------------ ! messages are :- transfer error (with bsp port number in p_port) ! r input done ! ring down %record (mef) %name mes %integer fn, i2, i fn=p_fn %if fn=r input done %start !validate input transfer and put bs info into global variables mes==p_mes !after processing the input the buffer in p_mes is released !unless p_mes is set to nil iport=mes_port i2=iport<<1 isource=mes_address %if mes_len<1 %then ->error tbsp==bs(i2) rbsp==bs(i2+1) itcomm=mes_tcomm ircomm=mes_rcomm %if iport=1 %start ssinput %else %if tbsp_dest#isource %then ->error process input %finish %unless p_mes==nil %then freebuffer(p_mes) %return error: fault(tbsp) errors = errors+1 %if mon > 0 %start printstring("bsp:illegal input from"); write(isource, 3); newline %finish freebuffer(p_mes) %else %if fn=transfer error %start fault(bs(p_port<<1)) %finish %finish %end %routine process input !--------------------- !input transfer has just finished ! assume it's byte stream and process the commands !if it's data the data will have been input into the !requisite buffer %if ircomm#0 %start %if ircomm&x'f000'=rdy %start do i rdy %else %if ircomm&x'f000'=notrdy %start do i not rdy %else %if ircomm&x'ff00'=reset %start do reset %return %else %if ircomm&x'ff00'=openack %start doopenack %else %if ircomm&x'ff00'=close %thenc do close %return %finish %finish %finish %finish %finish ! obey transmitter command %if itcomm & x'f000'=data %start do i data %else %if itcomm & x'f000' =nodata %thenc do i nodata %finish %end; !process input %routine ssinput !--------------------- %integer i,openflag,portn,f, ifacno, type %record (bsf) %name bsp !received open command or single shot request !see if there's a free port !also check there's not a bs open to this dest,port %if ircomm&x'ff00'=open %start type=incoming call %else %if ircomm&x'ff00'=sspreq %start type=message r %else %return %finish %finish ! swab the data in either message or call #if d %if p_mes_len <= 4 %then p_mes_len = 4 swaba(p_mes_a(0), 3) #else %if p_mes_len <= 4 %then p_mes_len = 4 %else %c swaba(p_mes_a(3), p_mes_len-4); !$e #fi p_mes_len=p_mes_len<<1-8-(ircomm&1); !$e - len is data only portn=0 %cycle i=4,2,bslim2-1 bsp==bs(i) %if bsp_state=closed %start portn=i >> 1 %else %if bsp_dest=isource %andc bsp_destport=(itcomm & x'fff') %then %return %finish %repeat %if portn#0 %start bsp==bs(portn<<1) f=0 ifacno=p_mes_a(0) &x'ff'; ! $ee %if 0<=ifacno&31<=max facility %then f=facility(ifacno&31) !f=task number of bsp owner !if message then set portn to 0, this is stored !in seq in the bs record and used as a reply port !on openack %if type=message r %then portn=0 init p rec(bsp, portn, open input, 0, f, %c isource, itcomm & x'fff') bsp_buf==p_mes; !save buffer to send openack p_mes==nil; !don't release buffer %if f#0 %start op_s1=ifacno op_len=isource op_mes==bsp_buf %if op_mes_a(2) = 0 %or op_mes_a(2) = 72 %start; ! source on ring, tidy address op_mes_a(2) = ring node no op_mes_a(1) = isource; ! allways correct now #if d swaba(op_mes_a(1), 2) #fi %finish send(bsp, type) %else send openack(bsp, 19) clearbsport(bsp) %finish %finish %end; !do open request %routine do open ack !--------------------- %record (mef) %name mes %integer flag mes==p_mes #if d flag = mes_a(0)>>8 #else flag=mes_a(0) #fi %if tbsp_state=open mess %start; !ack of message op_s1=0 %if flag#0 %then op_s1=1; !failed op_mes==mes; !pass buffer up p_mes==nil send(tbsp, message reply) clearbsport(tbsp) %return %finish %if tbsp_state#opening %or mes_len<2 %start error(6,isource) %return %finish %if itcomm&x'fff'=0 %then %return; !message reply!!!!! %if flag#0 %start; !fail flag on openack openfailed(tbsp, flag & x'ff') %else initport(tbsp_number<<1,tbsp_reply,isource,itcomm&x'fff') send to ring(xrdy, rbsp) rbsp_state=esent rbsp_tout=time op_s1=0 send(tbsp, open reply b) %finish %end %routine open failed(%record (bsf) %name bsp, %integer flag) !-------------------------------------------- %if flag=0 %then flag=18; !assume out oif order op_s1=flag; !failed flag send(bsp, open reply b) clearbsport(bsp) %end %routine error( %integer n, source) !------------------------------------- printstring("*********** error-") write(n, 3); write(source,3) newline !send pon to ring ser to force output of trace buffer op_ser=ring ser op_reply=own id op_fn=output trace ! pont(op) pon(op) %end %routine init p rec( %record (bsf) %name bsp, %c %integer seq,state,tout,reply,dest,destport) !----------------------------------------------------------------- !initialise one record of the byte stream pair bsp_sequence=seq bsp_closeflag=0 bsp_state=state bsp_tout=tout bsp_dest=dest bsp_reply=reply bsp_destport=destport bsp_buf==nil bsp_bufq_e==nil bsp_rdy command=xrdy; !normal (not expedited) rdy bsp_gah=initialgah; !note- 1 gets added to gah when port is !setup, see end of fns(call reply): !in routine from above %end %routine init port( %integer i, reply, dest, destport) !--------------------- !initialise receiver and transmitter data for port i !transmitter init p rec(bs(i), x'f', idle, (time+20) ! 1, %c reply, dest, destport) !receiver init p rec(bs(i+1), 0, nesent, 0, %c reply, dest, destport) %end; !initport %routine do i rdy !--------------------- %integer sq,sqin; !sequence numbers !ready command has been input !check sequence number sq=tbsp_sequence sqin=ircomm >> 8 &x'f' %if (sq+1)&x'f'=sqin %start %if tbsp_state=esent %start !rdy signals ack of previous data -release buffer etc. do data ack; %finish %if tbsp_state=esent %or tbsp_state=idle %start tbsp_sequence=sqin; !increment sequence !reply 'data' or 'nodata' depending on whether bufq is nil or not %if tbsp_bufq_e==nil %then tbsp_buf==nil %elsec tbsp_buf==pop(tbsp_bufq) tsend(tbsp) %else error(1, isource) %unless tbsp_state = closing; !$e %finish; !ignore it if state illegal %else %if sq=sqin %start !got repeated rdy - need to retransmit %if tbsp_state=esent %or tbsp_state=nesent %start tbsp_tout=0 tsend(tbsp) %if tbsp_state=esent %start retran = retran+1 %if mon > 0 %start printstring("Retransmit to "); write(isource,3) newline %finish op_ser=ring ser; op_reply=own id op_fn=output trace %if isource=30 %thenc pon(op) %finish %else error(2, isource) %finish %else error(3, isource) %finish %finish %end; !do i rdy %routine do i notrdy !--------------------- %integer sq,sqin; !sequence numbers !acknowledgement of data sq=tbsp_sequence sqin=ircomm>>8&x'f' %if (sq+1)&x'f'=sqin %start %if tbsp_state=esent %start do data ack; !release buffers etc. tbsp_state=idle %finish %finish %end; !do i notrdy %routine do data ack !--------------------- !release buffers, and reset the timeout %if tbsp_buf==nil %start !see if close request acknowledged %if tbsp_closeflag#0 %then tbsp_closeflag=2 %else send(tbsp, output done) freebuffer(tbsp_buf) tbsp_buf==nil %if tbsp_faultcount>0 %thenc tbsp_faultcount=tbsp_faultcount-1 %finish tbsp_tout=0 %end; !do data ack %routine do i data !--------------------- %integer i,sqin; !sequence number of input %record (mef) %name buf !data has been input buf==p_mes sqin=itcomm>>8&x'f' %if rbsp_sequence=sqin %and ( rbsp_state=esent %or %c rbsp_state=idle) %start !set new sequence number rbsp_sequence=(sqin+1)&x'f' rbsp_tout=0 rbsp_state=nesent %if rbsp_faultcount>0 %thenc rbsp_faultcount=rbsp_faultcount-1 %if itcomm&expedited data#0 %start rbsp_rdy command=xexprdy %else rbsp_rdy command=xrdy %finish %if itcomm & close request#0 %start %if itcomm&control data=0 %then process data rbsp_closeflag=1 send(rbsp, call closed) send to ring(xnotrdy, rbsp); !ack of close req %else %if itcomm & control data = 0 %start process data %finish SBR = SBR+1 %if rbsp_gah>0 %start send to ring(rbsp_rdy command, rbsp) rbsp_state=esent rbsp_tout=time %else send to ring(xnotrdy, rbsp) rbsp_state=nesent rbsp_tout=0 %finish %finish %else %if rbsp_sequence=((sqin+1)&x'f') %start !repeated data requeue rdy or notrdy %if rbsp_state=esent %start send to ring(rbsp_rdy command, rbsp) rbsp_tout=time %else %if rbsp_state=nesent %start send to ring(xnotrdy, rbsp) %else error(5, isource) %finish %finish %else error(4, isource) %finish %finish %end; !do i data %routine process data !---------------------- op_mes==p_mes p_mes==nil; !buffer to be retained !swab the data #if ~d swaba(op_mes_a(0), op_mes_len-1) #fi !convert buffer length to byte count op_mes_len=(op_mes_len <<1) - 2 - (itcomm & 1) send(rbsp, input done); !send messgae up rbsp_gah=rbsp_gah-1 %end %routine do i nodata !--------------------- %integer sqin !nodata response input sqin=itcomm>>8&x'f' %if rbsp_sequence=sqin %and rbsp_state=esent %start ! set idle timeout to 60 secs rbsp_tout=time+30 %if rbsp_tout=0 %then rbsp_tout=1 rbsp_state=idle %finish %end; !do i nodata %routine ttimedout(%record (bsf) %name bsp) !------------------------------------------- bsp_tout=0 %if bsp_faultcount=0 %start ttimen = ttimen+1 %if mon > 0 %start printstring("bsp:t timeout dest=") write(bsp_dest, 3) write(bsp_number,3) write(bsp_state,3) newline %finish %finish fault(bsp) %if bsp_state=esent %start tsend(bsp) %finish %if bsp_state=opening %start get buffer(bsp_number); !send open again %finish %end %routine rtimedout(%record (bsf) %name bsp) !------------------------------------------- bsp_tout=0 %if bsp_state#idle %start %if bsp_faultcount=0 %start rtimen = rtimen+1 %if mon > 0 %start printstring("bsp:r timeout dest=") write(bsp_dest, 3) write(bsp_number,3) write(bsp_state,3) newline %finish %finish fault(bsp) %finish %if bsp_state=idle %or bsp_state=esent %start send to ring(xrdy, bsp) bsp_state=esent bsp_tout=time %finish %end %routine send to ring(%integer fn, %record (bsf) %name bsp) !------------------------------------------------------------ op_ser=ring ser; op_reply=own id op_fn=fn op_port=bsp_number; %if fn&command mask>= xrdy %start op_len=bsp_dest op1_lport=bsp_destport op_s1=bsp_sequence %finish ! pont(op) pon(op) %end %routine tsend(%record (bsf) %name bsp) !--------------------- !send transmitter command (data or nodata) , if data !then calculate the length of the transfer from buf_len %record (mef) %name m m==bsp_buf %if m==nil %start !send nodata %if bsp_closeflag=0 %start send to ring(xnodata, bsp) bsp_state=nesent bsp_tout=0 %else !if closereq has been acknowledged then don't !send it again %if bsp_closeflag=2 %thenreturn send to ring(xclosereq, bsp) bsp_state=esent bsp_tout=time %finish %else bsp_state=esent m_address=bsp_dest m_port=bsp_destport m_rcomm=0 m_tcomm=bsp_sequence<<8 + data + (m_tcomm&1) op_mes==m !transmit data with buffer not released and no !notification at eot (unless it timeouts) send to ring(xdata, bsp) bsp_tout=time %finish %end; !tsend %routine initialise !------------------ %integer i %record (bsf) %name bsp pp==p; p3==pp; !$e op3==op op1==op !rest of data initialised to 0 %cycle i=2,1,bslim2 bsp==bs(i) clearbsport(bsp) bsp_number=i>>1 %repeat %end; !initialise %routine doreset !-------------- %end %routine doclose !-------------- %integer n n=tbsp_number %if closeable(tbsp_state)=0 %start finishclose(n) %else %if tbsp_closeflag=2 %then forceclose(n,call closed) %elsec forceclose(n, call aborted) finishclose(n) %finish %end %routine down(%record (bsf) %name bsp, %integer type) !!---------------------------- op_s1=bsp_dest send(bsp, type) %end %routine freebuffer(%record (mef) %name mes) !!-------------------------------------------- %record (pe) p p_ser=buffer manager; p_reply=own id p_fn=release buffer; p_mes==mes ! pont(p) pon(p) %end %routine get buffer(%integer port) !----------------------------------- op_fn=request buffer; op_ser=buffer manager op_reply=own id; op_port=port op_len=0; !long buffer ! pont(op) pon(op) %end %routine send openack(%record (bsf) %name bsp, %integer suflag) !-------------------------------------------------------------- ! buffer pointer saved in bsp_buf %record (mef) %name mes mes==bsp_buf bsp_buf==nil mes_address=bsp_dest ! mes_len=4; !$e (>4 for messages !) mes_port=bsp_destport mes_rcomm=openack mes_tcomm= bsp_sequence; !reply port saved here(=0 if message resp) #if d mes_a(0) = suflag<<8; ! ie 'swabbed' #else mes_a(0)=suflag #fi %if mes_len > 4 %start; !$e - data present #if ~d swaba(mes_a(1), mes_len-1); !$e #fi %FINISH %else mes_len = 4; !$e - ensure it is 4 op_mes==mes send to ring(xdata + release flag, bsp) %end %routine fault(%record (bsf) %name bsp) !-------------------------------------- %integer i %if bsp_state=open mess %then clearbsport(bsp) %and %return %if bsp_state=closing %thenc finishclose(bsp_number) %and %return i=bsp_faultcount %if i>faultlimit %start %if bsp_state=opening %start open failed(bsp, 18); !out of order %return %finish printstring("BSP:Call fails to N"); write(bsp_node, 1) printstring(" T"); write(bsp_dest, 1); newline forceclose(bsp_number, call aborted) %else bsp_faultcount=i+1 %finish %end %routine forceclose(%integer port, type) !------------------------------------------- %record (bsf) %name bsp bsp==bs(port << 1) %if bsp_state=open input %or bsp_state=open mess %then clearbsport(bsp) %if closeable(bsp_state) = 0 %then %return %if type#0 %then down(bsp, type) startclose(bsp); bsp==bs(port <<1 +1) startclose(bsp); !send close transfer send to ring(xclose, bsp) bsp_tout=time %end %routine startclose(%record (bsf) %name bsp) !----------------------------------------------------------- %integer x %record (mef) %name buf,p bsp_state=closing bsp_tout=0 !return active output buffer (if any) buf==bsp_buf bsp_buf==nil %unless buf==nil %start freebuffer(buf) %finish x = 0 %whilenot bsp_bufq_e==nil %cycle freebuffer(pop(bsp_bufq)) x = x+1; set prio(1) %if x&7=7; ! force re-schedule %repeat %end %routine finishclose(%integer port) !------------------------------------ %record (bsf) %name bsp bsp==bs(port<<1) clearbsport(bsp) clearbsport(bs(port<<1+1)) %end %routine clearbsport(%record (bsf) %name bsp) !----------------------------------------- bsp_tout=0 bsp_closeflag=0 bsp_dest=0 bsp_faultcount=0 bsp_reply=0 bsp_state=closed %end %routine send(%record (bsf) %name bsp, %integer fn) !-------------------------------------------------- %if bsp_reply # 0 %start op_ser=bsp_reply; op_reply=bsp ser op_fn=fn; op_port=bsp_number ! pont(op) pon(op) %finish %end %routine swaba(%integername addr,%integer count) !------------------------------------ !swab the bytes in the count words addressed by addr #if o ! ADDR IS IN R1 AND COUNT IS IN R0 *=K'000321'; !loop: swab (r1)+ *=K'005300'; !dec r0 *=K'003375'; !bgt loop #else %label loop %constinteger r1=1, r2=2 loop: *swab_(r1)+ *dec_r2 *bgt_loop #fi %end !%routine pont(%record (pe) %name p) ! ptrace(ptp)=p ! ptp=ptp+1 ! %if ptp>300 %then ptp=0 !%end !%routine puttrace !%record (pe3) %name p !%integer i,k ! ! selectoutput(1) ! i=ptp ! %cycle k=1,1,300 ! i=i-1 ! %if i<0 %then i=300 ! p==ptrace(i) ! %if p_ser=0 %then %exit ! %if p_ser=bsp ser %or p_ser=own id %start ! printstring(" ") ! write(p_reply,3) ! %else ! write(p_ser,3) ! %finish ! write(p_fn,3) ! write(p_port, 3) ! write(p_b<<8+p_a,6) ! write(p_c,3) ! write(p_d,3) ! newline ! %repeat ! closeoutput ! selectoutput(0) ! !%end %endofprogram