! file 'ring9s' - with monitoring back in
!********************************
!* emas-2900 ring interface *
!* handler *
!* file: ring8s *
!* date:04.feb.82 *
!*********************************
!new version to handle version 2 of TSBSP (Nov 82)
! prep options are:
! t trace buffer
! s stats gathering
! f fault generation to test higher level recovery
! k kent (if not kent assumed to be ERCC)
! g gateway version - different service no
! b monitor blipping (unselected with pkt count # 0)
!
!nb location k'140016 is used to hold the checksum so that it may
!be accessed from code
include "deimosperm"
constrecord (*) name nil == 0
begin
#if k
conststring (17) vsn = "ring:vsn012 (k) "
#else
conststring (13) vsn = "ring:vsn011a "
#fi
#datestring
ownintegername no of big buff == k'060112'; ! 3 seg position
ownintegername big buff pt == k'060104'; ! ditto
constintegername no of big 2 seg == k'100112'; ! for 2 seg buff man
constintegername big buff pt 2 seg== k'100104'
constintegername ps == k'017776'; ! processor status in seg 0
recordformat mef(record (mef) name link, byteinteger len,type, integer address, integerarray a(0:100))
recordformat pe(byteinteger ser,reply,fn,port,(record (mef) name mes, byteinteger len,s1 orinteger lport,hport))
!! ring interface registers
!-----------------------------
recordformat ringf(integer rdata,source,sourceselect,status,tdata,dest,spare,intstat)
constrecord (ringf) name ring==k'004040'; ! in seg 0
! ring command/status register bits
constinteger busy=1
constinteger unselected=2
constinteger accepted=4
constinteger ignored=8
constinteger badpacket=16
constinteger packet rejected=64
!ring interface status bits
constinteger receive=1
constinteger transmit=2
constinteger onoff=16
constinteger rintoff=k'40'
constinteger rinton=k'100'
constinteger tready=k'200'
constinteger tintoff=k'400'
constinteger tinton=k'1000'
constinteger iproff=k'2000'
constinteger ipron=k'4000'
constinteger iptoff=k'10000'
constinteger ipton=k'20000'
constinteger repa=k'100000'
!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 exp ack = x'6900'
constinteger exp ack2 = x'6902'; !with sequence number
constinteger exp data = x'6D00'
constinteger exp data2 = x'6d02'; !with sequence number
!transport service command codes
constinteger open=x'6a00'
constinteger openack=x'6500'
constinteger longblock=x'9000'
constinteger longblockch=x'9000'
constinteger longblockcs0=x'9400'
constinteger singleshot=x'9800'
! incoming function codes
! -------------------------
!he following values may be added to the output codes
constinteger release flag=x'80'; !release buffer at end of output
constinteger tell flag=x'40'; !notify at end of transfer
constinteger cs0flag=x'20'
constinteger command mask=x'1f'; !to get command code
constinteger enable port=0
constinteger xdata=1
constinteger ssout=2; !single shot output
constinteger xrdy=3
constinteger xnotrdy=4
constinteger xnodata=5
constinteger xclose=6
constinteger xreset=7
constinteger xclosereq=8
constinteger xexprdy=9
constinteger x disc response=10
constinteger x reset response=11
constinteger x disc ok=12
constinteger x null data=13
constinteger disable port=15
constinteger output trace=16; !force output of trace buffer
constinteger xexpack=17; !keep these in this order, all the xexp s
constinteger xexpdata=18
constinteger xexpack2=19
constinteger xexpdata2=20
! outgoing function codes
! -----------------------
constinteger output done=0
constinteger transfer error=1
constinteger r input done=2
constinteger input error=3
constinteger timeout=2; !number of alarm calls
!time is incremented on every alarm call, on overflow to
!zero it is set to 1 as time 0 implies time-not-set
owninteger ntimes=0
owninteger time
owninteger me=0; !ring address
integer t,i
!**************************************************************
!* buffer manager calls (from and to) *
!**************************************************************
constinteger buffer here = 0
!********** to buffer manager ***********
constinteger request buffer = 0
constinteger release buffer = 1
!****************************************************************
!********** various service numbers *************
#if k
#if g
constinteger ring ser = 7
#else
constinteger ring ser = 10
#fi
#else
constinteger ring ser = 13
#fi
constinteger buffer manager = 17
constinteger time int = 0
constbyteinteger tx int = -6;
constbyteinteger rx int = -7;
constinteger t3 ser = 21
!************************************************************
record (pe) p; !input pon record
record (pe) op; !output pon record
owninteger x, no buffc; ! no of 'no buff'
#if s
ownintegerarray rhist(0:6);
owninteger rcount;
owninteger ip,opkts,ints;
owninteger im, om, timec
#fi
#if f
owninteger eflag = 0;
owninteger ecount = 0;
#fi
owninteger mon = 0
owninteger intloop = 10
#if t
constinteger tracelim = 1023;
recordformat tracef(byteinteger type, integer data);
ownrecord (tracef) array trace(0:tracelim);
owninteger tracep = 0;
owninteger tsent=0;
#fi
!%ownrecord (pe) %array ptrace(0:300)
!%owninteger ptp=0
owninteger state=0
!values of state
constinteger closed=0; !before first entry
constinteger on=1; !normal state
constinteger off=2; !ring offline
owninteger dstate=0; !dynamic state (see bits below)
!values for dstate
constinteger idle=0
constinteger inputting=1
constinteger outputting=256
!data used during an input transfer
!----------------------------------
ownrecord (mef) name inbuf
owninteger port,csflag
constinteger maxlen=125; !250 bytes of data max
!data accessed in code therefore in fixed location the gla
constintegername ics==k'140016'; !checksum
constintegername ocs==k'140014'; ! output block checksum
!data used during output transfer
!---------------------------------
ownrecord (pe) outp
ownintegerarrayname obuf
owninteger dest, o pktcount, o pktlen, i tout, o tout,
outcs, d, oretry, func; !outcs#0 => checksum reqd
constinteger maxretries=500; !max number of retries of
!a single packet
!data used for input transfer
ownintegerarrayname i buf
owninteger i pktcount, i pktlen
!data used for port-pairs list
!-----------------------------
!each record contains a port range (low, high) and the id
!of the task that will handle input on a port in this range
recordformat ppf(integer lport,hport, byteinteger reply)
constinteger nppmax=8
ownrecord (ppf) array ppa(1:nppmax)
owninteger npp=0
ownrecord (ppf) name pp
!data used for output pon queue
!------------------------------
!all the pq records are on a cyclic list, pqfirst and pqlast point
!to the head and tail of the q, npq tells how many items are on the q.
recordformat pqf(record (pqf) name link, record (pe) p)
constinteger maxnpq=32
ownrecord (pqf) array pq(1:maxnpq)
ownrecord (pqf) name pqfirst, pqlast
owninteger npq=0
!data defining canned commands (rdy, nodata etc.)
!data defining 'canned' byte stream commands rdy etc. the command is
!put into the array ccbuf, ccbuf(0) is the port number, ccbuf(1) is
!the receiver command set from the reccom array, and ccbuf(2) is the
!transmitter command set from trancom array. the array sindex gives the position
!in ccbuf of the sequence number if reqd.
ownintegerarray ccbuf(0:3)
constintegerarray reccom(xrdy:xexpdata2)=rdy,
notrdy, 0, close, reset, 0, 0, close, reset, close, 0,
0, 0, 0, expack, expdata, expack2, expdata2
constintegerarray trancom(xrdy:xexpdata2)=0,
0, nodata, x'a042', x'a042', data+6, 0, 0, 0, x'8000', data,
0, 0, 0, 0, 0, 0, 0
constbyteintegerarray sindex(xrdy:xexpdata2)=1,1,2,0,0,2,2,0,0,0,2,
0,0,0,0,3,0,3
!%routinespec pont(%record (pe) %name p)
routinespec do clock int
routinespec end op transfer
routinespec end ip transfer
routinespec start input transfer
routinespec start output transfer
#if f
routinespec do forced error(integer type); !$s
#fi
routinespec do timeout(integer type)
routinespec freebuffer(record (mef) name mes)
record (mef) mapspec getbuffer
routinespec initialize
routinespec input done(integer function)
routinespec disports
#if t
routinespec puttrace;
#fi
!**********************************************
!* initialisation *
!**********************************************
map hwr(0); ! map top seg to seg 0
! set prio(2); !run at priority 2
i = map virt(buffer manager,4,3)
if i=0 start ; ! buf man only has 2 segs
no of big buff == no of big 2 seg
big buff pt == big buff pt 2 seg
finish
i = map virt(buffer manager,5,4); ! map to my seg 4
i = map virt(buffer manager,6,5); !and to seg 5
linkin(ring ser)
linkin(tx int); ; linkin(rx int)
change out zero = t3 ser
printstring(vsn)
#if t
printstring(" trace")
#fi
printstring(datestring); newline
initialize; !initialise data structures
alarm(20)
cycle
p_ser = 0; poff(p)
if p_ser=own id start ;
if p_reply=0 start ; !clock call
alarm(20)
do clock int
finishelsestart ; !from buffer manager
! pont(p)
printstring("RING:illegal message from:")
write(p_reply,1); newline
continue
finish
continue
finishelsestart
if p_ser=ring ser start
! pont(p)
!decode 'normal' pon message
if p_fn=enable port start
if npp>=nppmax start
printstring("RING:too many ports")
newline
finishelsestart
!add port pair to list
npp = npp+1
pp == ppa(npp)
pp_lport = p_lport
pp_hport = p_hport
pp_reply = p_reply
if state=closed start
!if this is the first entry, setup
!state according to the inverse of onoff
!so that the state change is recognised
if ring_intstat&onoff=0 then state = on else state = off
finish
finish
finishelsestart
if p_fn=disable port then dis ports andcontinue
if p_fn=output trace start
#if t
if tsent=0 then puttrace;
tsent = 1;
#fi
finishelsestart
!assume output request
if state=off start
rel: if p_fn&x'7f'<xrdy start ; ! block included
if p_fn&release flag#0 then free buffer(p_mes)
finish
continue ; ! ignore the request
finish
if npq<maxnpq start ; !put on output queue
pqlast == pqlast_link
pqlast_p = p
npq = npq+1
finishelsestart
printstring("RING:queue full")
newline
->rel
finish
finish
finish
finish
finish
#if s
if p_ser&x'80'#0 then ints = ints+1
#fi
!now cycle round a few times looking at ready bits on the ring interface
! dstate contains the dynamic state either idle, inputting or outputting
!
i = intloop-1
!turn off all interrupts - do all io using ready bits
ring_intstat = ring_intstat!(tint off+ipt off+rint off+ipr off)
while i<intloop cycle
i = i+1
ring_intstat = ring_intstat!(tint off+ipt off+rint off+ipr off)
if dstate&outputting#0 start
!output packet
!-------------
if ring_intstat&tready#0 start ; !transmitter ready
if ring_status&accepted#0 start ; !last transmission failed
#if b
if ring_status&unselected=0 and opktcount#0 start ; !blipped
printstring("ring:blip from"); write(dest,3); newline
do timeout(1)
continue
finish
#fi
if oretry>maxretries start
do timeout(1)
#if s
timec = timec+1
#fi
continue
finish
ring_intstat = ring_intstat!transmit; !send it again
oretry = oretry+1
i = 0
finishelsestart
#if s
if oretry<6 start ;
rhist(oretry) = rhist(oretry)+1;
finishelsestart ;
rhist(6) = rhist(6)+1;
finish ;
rcount = rcount+oretry;
#fi
if o pktcount<o pktlen start
d = o buf(o pktcount)
putout:
#if s
opkts = opkts+1;
#fi
o cs = o cs+d
*=k'005537'; *=k'140014'; !adc cs
#if t
trace(tracep)_type = 'o';
trace(tracep)_data = d;
tracep = (tracep+1)&tracelim;
#fi
#if f
if eflag#0 then do forced error('e');
#fi
ring_tdata = d
i = 0
oretry = 0
o pktcount = o pktcount+1
finishelsestart
if o pktcount=o pktlen and outcs#0 start
d = o cs
if outp_fn&cs0flag#0 then d = 0
->putout
finish
!end of output transfer
!----------------------
end output:
end op transfer
exitif dstate=0; ! force an interupt (input buffs)
finish
finish
finish
finishelsestart
if (ring_intstat&tready#0) or (ring_intstat&onoff=0) start
!start up output transfer (if any)
!----------------------------------
if npq#0 then start output transfer
finish
finish
if dstate&inputting#0 start
if ring_intstat&repa=0 thencontinue
d = ring_rdata
#if t
if inbuf_address#me start
trace(tracep)_type = 'i';
trace(tracep)_data = d;
tracep = (tracep+1)&tracelim;
finish
#fi
#if s
ip = ip+1;
#fi
!look to see if port field looks like a header and if so start transfer
!from here
! %if i pktcount=0 %and d&x'f800'=longblock %then ! -> start inp
#if f
if eflag#0 then do forced error('f');
#fi
i = 0
if i pktcount<i pktlen start
i cs = i cs+d
*=k'005537'; *=k'140016'; ! adc cs
ring_intstat = ring_intstat!receive
i buf(i pktcount) = d
i pktcount = i pktcount+1
finishelsestart
!end of input transfer
!-----------------------
end ip transfer
exitif dstate=0; ! force it to do a poff (input buffers)
finish
finishelsestart ; ! dstate=idle
if ring_intstat&repa#0 start
!start input transfer
! !--------------------
start inp:
start input transfer
i = 0
finish
finish
repeat
!need to switch interrupts back on
ring_intstat = ring_intstat!rinton
!now look to see if in middle of an output transfer - this implies
!we haven't seen the mini-packet come back. Either intloop is too small
!or the ring has gone down
if dstate&outputting#0 start
if ring_intstat & onoff = 0 start
do timeout(1); !abort the output transfer
else
ring_intstat = ring_intstat!tinton; !enable output interrupts
intloop=intloop+4; !increase intloop so it shouldn't happen again
printstring("Ring:reschedule during output transfer")
printstring(" intloop now="); write(intloop,1); newline
finish
finish
repeat
routine input done(integer function)
!-------------------
!find out who wants input to this port
integer port,i,xx
record (ppf) name pp
xx = 0; ! compiler bug forces this !
port = i buf(xx)
cycle i = npp,-1,1
pp == ppa(i)
if pp_lport<=port<=pp_hport start
op_ser = pp_reply
op_reply = ring ser
op_fn = function
if function=r input done start
op_mes == inbuf
! pont(op)
pon(op)
inbuf == nil
finishelsestart
! pont(op)
pon(op)
finish
return
finish
repeat
!nobody wants the input
printstring("RING:input rejected ")
write(port,3); write(inbuf_address,3)
newline
end
routine do clock int
!--------------------
integer i
time = time+1
if time=0 then time = 1; !time=0 => time not set
if ring_intstat&onoff=0 start
if dstate&outputting#0 then do timeout(1)
if dstate&inputting#0 then do timeout(0)
if state=on start
printstring("****************** ring switched off")
newline
state = off
finish
finishelsestart
if state=off start
!calculate my ring address
!turn off all interrupts
ring_intstat = ring_intstat!(tint off+ipt off+rint off+ipr off)
while me=0 cycle
cycle i = 1,1,254
ring_sourceselect = i
ring_intstat = ring_intstat!receive
ring_dest = i
ring_tdata = x'f0f0'
while ring_intstat&tready=0 cycle
if ring_intstat&onoff=0 then ->out
repeat
if ring_intstat#0 and ring_rdata=x'f0f0' then me = i andexit
repeat
repeat
printstring("ring online")
write(me,3)
newline
for i = 1,1,3 cycle ; !send 3 pkts to invalid
ring_dest = 1; ring_tdata = 16_f0f0
while ring_intstat&tready=0 cycle ; repeat
repeat
!now count how long it takes
i = 0
ring_tdata = 16_f0f0
while ring_intstat&tready=0 cycle
i = i+1
repeat
!the loop takes 16usecs so the ring cycle time is equal to i*16/18 usecs
printstring("Ring cycle=")
write(i*16//18,3); printstring(" microsecs"); newline
state = on
!initialize ring interface
ring_intstat = ring_intstat!(receive+iproff+iptoff+rinton)
ring_sourceselect = -1
finish
finish
out:
if 'M'<=int<='P' start
mon = int-'O'; int = 0
finish
if int='?' start
int = 0
printstring("o/p queued ="); write(npq,1); newline
finish
x = x+1;
if x>=150 start ; !every minute with alarm(20) set
x=0;
if no buffc#0 start
printstring("RING: No buffer count =")
write(no buffc,1); newline
no buffc = 0
finish
#if s
if mon>0 start ;
select output(1)
printstring("RING:");
write(rcount,5);
cycle i = 0,1,6;
write(rhist(i),4);
repeat ;
write(ip,4);
write(opkts,4);
write(ints,4);
write(im,5);
write(om,1);
write(timec,1);
newline;
select output(0); !$s
finish ;
im = 0;
om = 0;
rcount = 0;
x = 0;
ip = 0;
opkts = 0;
ints = 0;
cycle i = 0,1,6;
rhist(i) = 0;
repeat ;
#fi
finish ;
#if f
if int='E' start ;
eflag = (eflag+1)&1;
printstring("eflag=");
write(eflag,1);
newline;
int = 0;
finish ;
#fi
#if t
if int='H' start
intloop = (intloop+1)//2
printstring("intloop="); write(intloop,1); newline
int = 0
finish
if int='D' start
intloop = intloop*2
printstring("intloop="); write(intloop,1); newline
int = 0
finish
if int='T' start ;
puttrace;
int = 0;
finish ;
#fi
#if t
! trace(tracep)_type='s';
! trace(tracep)_data=time;
! tracep=(tracep+1) & tracelim;
#fi
if i tout#0 and time-i tout>timeout then do timeout(0)
if o tout#0 and time-o tout>timeout then do timeout(1)
end
routine end op transfer
!-----------------------
dstate = dstate&(¬outputting)
o tout = 0
if outp_fn&release flag#0 then freebuffer(outp_mes)
if outp_fn&tell flag#0 start
op_ser = outp_reply
op_reply = ring ser
op_fn = output done
pon(op)
finish
end
routine end ip transfer
!-----------------------
ring_sourceselect = -1
ring_intstat = ring_intstat!receive
if csflag#0 then i cs = 0; !zero checksum reqd.
if d=i cs start
input done(r input done)
finishelsestart
printstring("RING:checksum fail from ")
write(inbuf_address,3)
write(d,3); write(i cs,3); newline
finish
i tout = 0
dstate = dstate&(¬inputting)
end
routine start input transfer
!----------------------------
d = ring_rdata
#if t
if ring_source#me start
trace(tracep)_type = 'i';
trace(tracep)_data = d;
tracep = (tracep+1)&tracelim;
finish
#fi
if d&x'f800'=longblock start
csflag = d&x'400'
i pktlen = d&x'3ff'+2
if i pktlen>maxlen start
printstring("Ring: block too long (")
write(i pktlen,-1); printstring(") from ")
write(ring_source,-1); newline
-> skip
finish
i pktcount = 0
if inbuf==nil start ; !$e - kent fault
inbuf == get buffer; ! grab a buffer from buf man
if inbuf==nil start
no buffc = no buffc+1
skip:
ring_intstat = ring_intstat!receive
return
finish
#if s
im = im+1
#fi
finish
inbuf_len = i pktlen-2
i buf == inbuf_a
inbuf_address = ring_source
ring_sourceselect = ring_source
ring_intstat = ring_intstat!receive
dstate = dstate!inputting
i cs = d
i tout = time
return
finish
->skip
end
routine start output transfer
!-----------------------------
outp = pqfirst_p
pqfirst == pqfirst_link; !remove record
npq = npq-1; !from output q
func = outp_fn&command mask
#if s
om = om+1;
#fi
if func=ssout start ; !single shot block
dest = outp_mes_address
o pktcount = 1
o buf == outp_mes_a
o pktlen = outp_mes_len
if o pktlen=0 start
end op transfer
return
finish
o cs = o buf(0); !first packet
outcs = 0; !no checksum
finishelsestart
if func<xrdy start
!output given buffer
!-------------------
dest = outp_mes_address
o buf == outp_mes_a
o pktlen = outp_mes_len+2
finishelsestart
!output byte stream command
!----------------------------
dest = outp_len
o pktlen = 3
ccbuf(0) = outp_lport
ccbuf(1) = reccom(func)
ccbuf(2) = trancom(func)
o buf == ccbuf
!see if sequence number reqd
i = sindex(func)
if i=3 then ccbuf(3) = 0 and opktlen = 4; !exp data
if i#0 then ccbuf(i) = ccbuf(i)+(outp_s1<<8); !add in sequence
finish
o cs = longblockch+o pktlen-2
if outp_fn&cs0flag#0 then o cs = o cs!longblockcs0
outcs = 1; !checksum reqd
o pktcount = 0
finish
ring_dest = dest
ring_tdata = o cs
#if t
trace(tracep)_type = 'o';
trace(tracep)_data = o cs;
tracep = (tracep+1)&tracelim;
#fi
oretry = 0
o tout = time
dstate = dstate!outputting
i = 0
end
#if f
routine do forced error(integer type); !$s
!---------------------------------------
ecount = ecount+1;
if ecount>1000 start ;
d = d+1;
ecount = 0;
#if t
trace(tracep)_type = type;
trace(tracep)_data = 0;
tracep = (tracep+1)&tracelim;
#fi
finish ;
end
#fi
routine do timeout(integer type)
!----------------
if type=1 start ; ! outputting timeout
o tout = 0
#if s
timec = timec+1
#fi
if mon<0 start
printstring("RING:output timeout to")
write(dest,3); newline
finish
op_ser = outp_reply
op_reply = ring ser
op_fn = transfer error
op_port = outp_port
! pont(op)
pon(op)
if outp_fn&release flag#0 then freebuffer(outp_mes)
dstate = dstate&(¬outputting)
finishelsestart
! must be input timeout
!send message if port number has been input
i tout = 0
if i pktcount>0 then inputdone(input error)
!return the input buffer
unless inbuf==nil start
printstring("RING:Input Timeout from")
write(inbuf_address,3); newline
finish
ring_intstat = ring_intstat!receive
ring_sourceselect = -1
dstate = dstate&(¬inputting)
finish
#if t
trace(tracep)_type = 'x';
trace(tracep)_data = 0;
tracep = (tracep+1)&tracelim;
#fi
end
routine initialize
!------------------
integer i
!initialise pon q as cyclic list
pqfirst == pq(1)
pqlast == pq(maxnpq)
cycle i = 1,1,maxnpq-1
pq(i)_link == pq(i+1)
repeat
pq(maxnpq)_link == pq(1)
npq = 0
end
routine freebuffer(record (mef) name mes)
!-----------------------------------------------
record (pe) p
integer x
if mes_type # 0 start ; !small buffer
p_ser = buffer manager
p_reply = own id
p_fn = release buffer
p_mes == mes
pon(p)
return
finish
!big buffer connected directly back into buff mans free chain
mes_type = mes_type ! 1; !buffer free flag
ps = ps!k'340'; ! put processor status = 7
no of big buff = no of big buff+1
x = addr(mes)+k'20000'; ! addr wrt buffer manager vm
integer(addr(mes)) = big buff pt; ! copy in top of chain
big buff pt = x; ! and remake 1st entry
ps = ps&(¬k'340'); ! and allow ints again
end
record (mef) map getbuffer
!-----------------
integer x
record (mef) name mes
ps = ps!k'340'; ! stop processor interrupts
if no of big buff>5 start ; ! leave some (no queuing done)
no of big buff = no of big buff-1
x = big buff pt; ! get buffer managers free pointer
x = x-k'20000'; ! make it my vm (my seg 3 = bm seg 4)
big buff pt = integer(x); ! copy rest of free queue
ps = ps&(¬k'340'); ! allow ints again
mes == record(x)
mes_type = mes_type & (8_376); !remove 'free' buffer bit
result == record(x); ! and pass back result
finish
ps = ps&(¬k'340')
result == null
end
routine disports; !disable port by removing
!----------------- !from port pairs list
integer i,j
cycle i = 1,1,npp
pp == ppa(i)
if pp_lport=p_lport and pp_hport=p_hport and pp_reply=p_reply start
cycle j = i,1,npp-1
ppa(j) = ppa(j+1)
repeat
npp = npp-1
return
finish
repeat
end
#if t
routine addvchar(string (*) name s, integer c)
!-------------------------------------------------
if c<32 or c>126 then c=' '
length(s)=length(s)+1
charno(s, length(s))=c
end
routine puthex(integer d, string (*) name vstr)
!-------------------------------------------------
integer i;
byteinteger s;
printsymbol(' ');
cycle i = 12,-4,0;
s = (d>>i)&x'f';
if s>9 then s = s-'0'+'a'-10;
printsymbol(s+'0');
repeat ;
addvchar(vstr, d>>8)
addvchar(vstr, d & 16_ff)
end ;
routine put visi chars(string (*) name s, integer c)
!-------------------------------------------------------
if c=0 then return
spaces( (16-c)*5+2 )
printstring(s); newline
end
routine puttrace;
!----------------;
integer tplast,tp,tc;
string (32) vstr; !visible char form
integer ty,type;
tc = 0;
vstr = ""
tp = (tracep+1)&tracelim;
selectoutput(1);
type = 0;
cycle ;
ty = trace(tp)_type;
if ty#0 start ;
trace(tp)_type = 0;
if ty#type start ;
put visi chars(vstr, tc)
printstring("******** ");
printsymbol(ty);
tc = 2;
vstr=" "
type = ty;
finish ;
if tc>=16 start
put visi chars(vstr, tc)
vstr=""
tc = 0
finish
puthex(trace(tp)_data, vstr); !save visible chars in vstr
tc = tc+1;
finish ;
tp = (tp+1)&x'3ff';
repeatuntil tp=tracep;
newline;
printstring("end of trace");
newline;
closeoutput
selectoutput(0);
printstring("done");
newline;
end ;
#fi
!%routine pont(%record (pe) %name p)
! ptrace(ptp)=p
! ptp=ptp+1
! %if ptp>300 %then ptp=0
!%end
endofprogram