! New 2MHz-ether handler for "interim" Mouse, GDMR, Dec 1987. ! This handler runs the station in "raw" mode. It speaks the "standard" ! protocol (type 01/81), providing a port-like interface, and in addition ! allows the use of other protocol-types (for IP, ARP and the like). ! Note that we have two interrupt handlers: one for the station itself and ! one for the clock (IPL 4 and 6) -- this allows us to deal with user timeouts ! and old-protocol ACK-timeouts. %externalstring(47) copyright %alias "GDMR_(C)_2MEG" = %c "Copyright (C) 1987 George D.M. Ross" %constinteger ether packet size = 768; ! Includes header %constinteger RX buffers = 64; ! 2^n %constinteger reTX lives = 6 %constinteger old protocol slots = 48 %constinteger first station = 16_10 %constinteger last station = 16_7F %constinteger last registered = 16 %constinteger inbound handler size = 8192 %constinteger inbound handler priority = 7 %constinteger outbound handler size = 8192 %constinteger outbound handler priority = 7 %constinteger old inbound handler size = 8192 %constinteger old inbound handler priority = 7{6 %constinteger old timeout handler size = 8192 %constinteger old timeout handler priority = 6 %option "-nonstandard-low-nocheck-nodiag-noline" %include "Moose:Mouse.Inc" %include "GDMR_E:2Meg.Inc" %include "GDMR_H:Lights.Inc" %constinteger lights type = 16_80 %constinteger lights sending = 16_40 %constinteger lights outbound = 16_20 %constinteger lights old outbound = 16_10 %constinteger lights old reTX = 16_08 %constinteger lights inbound = 16_20 %constinteger lights old inbound = 16_10 %constinteger lights clear = 16_F8 !! %include "INet:Dump.Inc" %externalroutinespec FS insert(%string(31) what, %integer value) %systemintegerfnspec global heap get(%integer size) %systemintegerfnspec free store %externalroutinespec phex(%integer i) %externalroutinespec phex2(%integer i) ! Clock definitions and interrupt handler %constinteger clock priority = 6 %owninteger timestamp = 0 %ownrecord(semaphore fm) clock semaphore = 0 %routine start ticking %ownrecord(interrupt handler fm) handler = 0 %label clock handler, no setup interrupt handler(handler, addr(clock handler)) add interrupt handler(handler, clock priority) !! printstring("Ether module's clock handler inserted"); newline %return clock handler: *move.l timestamp, D0 { Every clock interrupt (or, at least, every *addq.l #1, D0 { level-6 interrupt) we bump the decisecond *move.l D0, timestamp { timestamp. If it is even (every 1/5 second) *btst.l #0, D0 { we signal the timeout process's semaphore: *bne no { (not this time round, ->) int signal semaphore(clock semaphore) no: return from interrupt *move.l D0, D0; ! HMD-proof it %end ! Ether station definitions @16_7FFFC %readonly %volatile %byte status @16_7FFFC %writeonly %byte command @16_7FFFD %writeonly %byte data @16_7FFFF %writeonly %byte control %constinteger DTX = 16_30 %constinteger RDY = 16_10 %constinteger STX = 16_20 %constinteger ETX = 16_0B %constinteger ACK = 16_C0 %constinteger ESA = 16_05 %constinteger SSA = 16_07 %constinteger RAW = 16_02 %constinteger int bit = 7, int mask = 1 << int bit %constinteger rst bit = 6, rst mask = 1 << rst bit %constinteger td bit = 3, td mask = 1 << td bit %constinteger rd bit = 2, rd mask = 1 << rd bit %constinteger rc bit = 1, rc mask = 1 << rc bit %constinteger rcd bit = 0, rcd mask = 1 << rcd bit %constinteger enable station interrupts = rc mask ! rd mask %constinteger disable station interrupts = 0 %constinteger station interrupt level = 4 %constinteger station interrupts off = 16_0400; ! For SR ! Statistics %owninteger station address = 0 %owninteger buffer low water = 16_7FFFFFFF %owninteger pended DTX = 0 %owninteger unrecognised control = 0 %owninteger inbound packets = 0 %owninteger inbound bytes = 0; ! Includes header (14 bytes) %owninteger outbound packets = 0 %owninteger outbound bytes = 0; ! Includes header (14 bytes) %owninteger dud destinations = 0 %owninteger dud types = 0 %owninteger old inbound packets = 0; ! Data packets, not ACKs %owninteger old outbound packets = 0; ! Data packets, not ACKs %owninteger old inbound no takers = 0 %owninteger old retransmits = 0 %owninteger old ACK timeouts = 0 %owninteger old user timeouts = 0 %owninteger old defines = 0 %owninteger old redefines = 0 %owninteger old undefines = 0 %owninteger old reads = 0 %owninteger old writes = 0 ! Buffer pool management %recordformat ether header fm(%byte ds, dp, dz0, dz1, dz2, dz3, %byte ss, sp, sz0, sz1, sz2, sz3, %byte type, seq) %constinteger old data type = 16_01 %constinteger old ACK type = 16_81 %recordformat RX buffer fm(%record(RX buffer fm)%name next, %integer bytes, (%bytearray data(1 : ether packet size) %or %c %record(ether header fm) header)) %ownrecord(RX buffer fm)%name RX free list == nil %ownrecord(RX buffer fm)%name inbound queue == nil %ownrecord(semaphore fm) inbound packet arrived = 0 %ownrecord(RX buffer fm)%name old inbound queue == nil %ownrecord(semaphore fm) old packet arrived = 0 %ownrecord(semaphore fm) old queue semaphore = 0 %owninteger buffers remaining { for information only } = 0 %routine setup RX free list %record(RX buffer fm)%name x %integer i %for i = 1, 1, RX buffers %cycle x == record(global heap get(4 + 4 + ether packet size + 4)) x_next == RX free list RX free list == x %repeat buffers remaining = RX buffers %end %routine release RX buffer(%record(RX buffer fm)%name buffer) %integer old SR !! printstring("Release RX buffer "); phex(addr(buffer)); newline buffer low water = buffers remaining %if buffers remaining < buffer low water old SR = or to SR(station interrupts off) %if RX free list == nil %then buffers remaining = 1 %c %else buffers remaining = buffers remaining + 1 buffer_next == RX free list RX free list == buffer old SR = set SR(old SR) %end %ownbytename TX buffer1 == nil, TX buffer2 == nil %owninteger TX bytes1 = 0, TX bytes2 = 0 %ownrecord(semaphore fm) TX done = 0 ! Station interrupt handler %routine setup station handler %ownrecord(interrupt handler fm) station interrupt handler = 0 %owninteger old SR, RX buffer, pending DTX = -1 %label interrupt, check for control, control arrived, done %label DTX arrived, DTX 0, DTX 1, DTX 2, DTX d, DTX 3, DTX b %label RDY arrived, RDY 0, RDY 1, RDY 2, RDY 3, RDY 4, RDY 5 %label STX arrived, STX 0, STX 1, STX c %label ACK arrived, ACK 0 %label SSA arrived, SSA w old SR = or to SR(station interrupts off) command = rst mask; ! Ints off, reset the station command = 0 setup interrupt handler(station interrupt handler, addr(interrupt)) add interrupt handler(station interrupt handler, station interrupt level) command = enable station interrupts %while status & td mask = 0 %cycle; %repeat control = RAW %while status & td mask = 0 %cycle; %repeat control = ESA; ! Kick it into life old SR = set SR(old SR) %while station address = 0 %cycle; %repeat !! printstring("2MHz handler initialised, station address is ") !! phex2(station address); newline %return interrupt: ! The interupt handler proper. We enable interrupts for received data ! and control characters (cleared by reading the appropriate register). ! The following may be received: ! DTX: something has arrived from the wire ! STX: the packet we asked for is coming up next ! ETX: our packet has just finished (this won't cause an interrupt ! as we're in a busy-wait loop at the time reading the packet) ! RDY: the station is ready for our (TX) packet ! ACK: can be ignored! ! SSA: the station address is coming up next. ! Since we're in "raw" mode the "port" part of these will always be zero. ! Note, however, that it will be present and must be explicitly handled. ! If it's anything we don't recognise we log it and ignore it. We have ! reasonable control over the receipt of everything except DTX, which ! is driven by packets arriving off the wire. Since we're only geared ! up to handle one receive buffer at a time we tally the "extra" DTXs ! for future processing. ! ! Note: data is transferred in a busy-wait loop in the interrupt handler. ! This should result in less overhead than interrupt-per-character would. ! Any data interrupts are assumed to be caused by the station misbehaving: ! the character is read (to clear the condition) and thrown away. ! First off, read the status register to see if the interrupt was for us. ! If it wasn't we just return; if it was we fetch the control character ! (or read and throw away the data character). *btst.b #int bit, status { Ether station interrupting? *bne check for control { Yes, -> see what it was return from interrupt check for control: *btst.b #rc bit, status { Was it a control character? *bne control arrived { Yes, -> process it *move.b data, D0 { Must have been data, so read it.... {} D0 = D0 & 255; put long(D0); put sym(' ') return from interrupt { .... and ignore it. control arrived: *move.b control, D1 *cmp.b #DTX, D1 *beq DTX arrived *cmp.b #RDY, D1 *beq RDY arrived *cmp.b #STX, D1 *beq STX arrived *cmp.b #ACK, D1 *beq ACK arrived *cmp.b #SSA, D1 *beq SSA arrived ! Something unknown {} D1 = D1 & 255 {} put sym(NL); put sym('^'); put long(D1); put sym(' ') *addq.l #1, unrecognised control ! And fall through.... done: command = enable station interrupts return from interrupt DTX arrived: DTX 0:*btst.b #rd bit, status { 2-byte protocol, look for the *beq DTX 0 { second (port) byte and *move.b data, D0 { throw it away ! A DTX has arrived. Is there one pending already? *addq.l #1, pending DTX { Bump pending tally *beq DTX b { Nothing else waiting, -> process it *addq.l #1, pended DTX { Tally it -> done { Must wait meantime DTX b:! No DTX pending. Claim a buffer. If there isn't one then ask ! the station to drop the packet. Otherwise, send a RDY. *move.l RX free list, A0 { First on the free list *move.l A0, D0 { Anything on free list? *beq DTX d { None, -> drop *move.l (A0), RX free list { Unlink it *move A0, RX buffer { Note it *subq.l #1, buffers remaining DTX 1:*btst.b #td bit, status { TX empty? *beq DTX 1 *move.b #RDY, control { Tell station we're ready DTX 2:*btst.b #td bit, status { TX empty? *beq DTX 2 *move.b #0, data { Null port byte -> done DTX d:*btst.b #td bit, status { TX empty? *beq DTX d *move.b #ACK, control { Tell station to throw it away DTX 3:*btst.b #td bit, status { TX empty? *beq DTX 3 *move.b #0, data { Null port byte !! put sym('!') -> done STX arrived: STX 0:*btst.b #rd bit, status { 2-byte protocol, look for the *beq STX 0 { second (port) byte and *move.b data, D0 { throw it away ! The STX has arrived. Data will be arriving next. Read it in and ! tally it. When the ETX arrives put the buffer on the arrived ! queue and signal the inbound handler's semaphore. *move.l RX buffer, A0 { Previously-allocated buffer *lea 8(A0), A1 { Start of data area *clr.l D1 { Zap tally STX 1:*btst.b #rcd bit, status { Anything arrived? *beq STX 1 *btst.b #rd bit, status { Control (ETX) or data? *beq STX c *move.b data, D0 { Read the character *move.b D0, (A1)+ { Save it *addq.l #1, D1 { Bump tally -> STX 1 { Round for the next one STX c:*move.b control, D0 { Must have been the ETX?? *move.l D1, 4(A0) { Note packet size *move.l inbound queue, A1 { Tail of stuff waiting *move.l A1, (A0) { Link it on *move.l A0, inbound queue { Link us in int signal semaphore(inbound packet arrived) *subq.l #1, pending DTX { Note packet has been done *bge DTX b { More still to do, -> get buffer RX buffer = 0 { Nothing pending, zap for safety -> done RDY arrived: RDY 0:*btst.b #rd bit, status { 2-byte protocol, look for the *beq RDY 0 { second (port) byte and *move.b data, D0 { throw it away ! This must have been in response to our DTX. The TX buffer address ! and length will already have been set up, so all we have to do is ! hand it on to the station, bracketed by STX/ETX. Since we're in raw ! mode the packet must be at least 13 bytes long, so we don't have to ! worry about dealing with awkward empty ones.... RDY 1:*btst.b #td bit, status { TX empty? *beq RDY 1 *move.b #STX, control { Tell station we're ready RDY 2:*btst.b #td bit, status { TX empty? *beq RDY 2 *move.b #0, data { Null port byte ! We can, optionally, concatenate two buffers together to avoid copying. ! Set up and send the first one. *move.l TX bytes1, D0 { Number of bytes to send *subq.l #1, D0 { (for dbra) *move.l TX buffer1, A0 { Address of first byte to go RDY 3:*btst.b #td bit, status { TX empty? *beq RDY 3 *move.b (A0)+, data { Next data byte to go *dbra D0, RDY 3 { Any more? ! Now for the second buffer.... *move.l TX bytes2, D0 { Number of bytes to send *ble RDY 5 { None in second part *subq.l #1, D0 { (for dbra) *move.l TX buffer2, A0 { Address of first byte to go RDY 4:*btst.b #td bit, status { TX empty? *beq RDY 4 *move.b (A0)+, data { Next data byte to go *dbra D0, RDY 4 { Any more? RDY 5:*btst.b #td bit, status { TX empty? *beq RDY 5 *move.b #ETX, control { Tell station we're done int signal semaphore(TX done) -> done ACK arrived: ! This is just in to keep the host/station protocol the same for raw ! mode as it is for cooked mode. We just read the port byte and ! ignore it all.... ACK 0:*btst.b #rd bit, status { 2-byte protocol, look for the *beq ACK 0 { second (port) byte and *move.b data, D0 { throw it away -> done SSA arrived: ! The next data character will be the station address SSA w:*btst.b #rd bit, status *beq SSA w *lea station address, A0 *move.b data, 3(A0) -> done %end ! Inbound packet handler %recordformat icb fm(%integer active, %record(RX buffer fm)%name pending packets, %record(ether request fm)%name pending reads) %ownrecord(icb fm)%array icbs(2 : last registered) = 0(*) %ownrecord(semaphore fm) icb semaphore = 0 %routine copy out(%record(RX buffer fm)%name from, %record(ether request fm)%name to) %integer f, t %label L to_bytes = from_bytes - 14 %if to_bytes > 0 %start ! Beware null packets f = addr(from_data(15)) t = addr(to_buffer) D0 = to_bytes - 1; A0 = f; A1 = t L: *move.b (A0)+, (A1)+ *dbra D0, L %finish to_ra = from_header_ss to_type = from_header_type %end %routine inbound packet handler %record(RX buffer fm)%name buffer, last %record(icb fm)%name icb %record(ether request fm)%name rr %integer old SR, i, n open input(3, ":N"); select input(3) open output(3, ":T"); select output(3) {} printstring("Inbound handler: "); write(free store, 0); newline %cycle {L} lights and A(\ lights inbound) semaphore wait(inbound packet arrived) {L} lights or A(lights inbound) %cycle last == nil old SR = or to SR(station interrupts off) old SR = set SR(old SR) %and %exit %if inbound queue == nil buffer == inbound queue last == buffer %and buffer == buffer_next %while buffer_next ## nil %if last == nil %then inbound queue == nil %c %else last_next == nil old SR = set SR(old SR) ! We've unlinked the first pending packet. Deal with it. inbound packets = inbound packets + 1 inbound bytes = inbound bytes + buffer_bytes %if 0 # buffer_header_ds # station address %start ! Not for us !! printstring("Dud destination received: ") !! n = buffer_bytes; n = 18 %unless 0 <= n < 18 !! phex2(buffer_data(i)) %and space %for i = 1, 1, n !! newline release RX buffer(buffer) dud destinations = dud destinations + 1 %else %if buffer_header_type = old data type %c %or buffer_header_type = old ACK type ! Forward the buffer to the old-style protocol handler. Let it ! free the buffer when it's finished semaphore wait(old queue semaphore) %if old inbound queue == nil %start old inbound queue == buffer %else last == old inbound queue last == last_next %while last_next ## nil last_next == buffer %finish buffer_next == nil signal semaphore(old queue semaphore) signal semaphore(old packet arrived) %else %if 2 <= buffer_header_type <= last registered !! write(buffer_bytes, 0); printstring(" inbound:"); newline !! dump(buffer_data(1), buffer_bytes) semaphore wait(icb semaphore) icb == icbs(buffer_header_type) %if icb_active = 0 %start !! printstring("Inactive type "); phex2(buffer_header_type) !! printstring(" received: ") !! n = buffer_bytes; n = 18 %unless 0 <= n < 18 !! phex2(buffer_data(i)) %and space %for i = 1, 1, n !! newline release RX buffer(buffer) dud types = dud types + 1 %else %if icb_pending reads == nil %start ! Nothing waiting, so put it on the end of the list !! printstring("Nothing waiting, put at end"); newline buffer_next == nil %if icb_pending packets == nil %start icb_pending packets == buffer %else last == icb_pending packets last == last_next %while last_next ## nil last_next == buffer %finish %else ! There's a read request already waiting, so complete it !! printstring("Complete pending"); newline rr == icb_pending reads icb_pending reads == rr_next copy out(buffer, rr) release RX buffer(buffer) rr_status = ether success send message(rr, rr_system part_reply, nil) %c %if rr_system part_reply ## nil %finish %finish signal semaphore(icb semaphore) %else !! printstring("Unknown type "); phex2(buffer_header_type) !! printstring(" received: ") !! n = buffer_bytes; n = 18 %unless 0 <= n < 18 !! phex2(buffer_data(i)) %and space %for i = 1, 1, n !! newline release RX buffer(buffer) dud types = dud types + 1 %finish %repeat %repeat %end ! Outbound packet handler %ownrecord(semaphore fm) outbound semaphore = 0 %ownrecord(mailbox fm) outbound mailbox = 0 %recordformat outbound message fm(%record(message fm) system part, %bytename buffer1, %integer bytes1, %bytename buffer2, %integer bytes2, %record(semaphore fm)%name done) %routine outbound packet handler %record(outbound message fm)%name m %record(RX buffer fm)%name loop %integer i, old SR %bytename b open input(3, ":N"); select input(3) open output(3, ":T"); select output(3) {} printstring("Outbound packet handler: "); write(free store, 0); newline %cycle {L} lights and B(\ lights outbound) m == receive message(outbound mailbox) {L} lights or B(lights outbound) %if m_bytes1 >= 13 %start outbound packets = outbound packets + 1 outbound bytes = outbound bytes + m_bytes1 outbound bytes = outbound bytes + m_bytes2 %if m_bytes2 > 0 !! write(m_bytes1, 0) !! printstring(" + ") %and write(m_bytes2, 0) %if m_bytes2 > 0 !! printstring(" to send: ") !! b == m_buffer1 !! %for i = 1, 1, m_bytes1 %cycle !! phex2(b); space !! b == b [1] !! %repeat !! newline !! %if m_bytes2 > 0 %start !! b == m_buffer2 !! %for i = 1, 1, m_bytes2 %cycle !! phex2(b); space !! b == b [1] !! %repeat !! newline !! %finish !! b == m_buffer1 !! %if b [12] = 6 %start !! write(m_bytes1, 0); printstring(" + ") !! write(m_bytes2, 0); printstring(" out:"); newline !! dump(m_buffer1, m_bytes1); dump(m_buffer2, m_bytes2) !! %finish ! Set up pointers for the transfer TX buffer1 == m_buffer1; TX bytes1 = m_bytes1 TX buffer2 == m_buffer2; TX bytes2 = m_bytes2 %if TX buffer1 = station address %start ! Destination = us, loopback. First grab a RX buffer. !! printstring("2Meg loopback"); newline old SR = or to SR(station interrupts off) loop == RX free list RX free list == loop_next %if loop ## nil old SR = set SR(old SR) ! If we've got a buffer, copy the two data segments and ! then enqueue the buffer on the inbound queue. %if loop ## nil %start b == loop_data(1); loop_bytes = 0 %while TX bytes1 > 0 %cycle b = TX buffer1 b == b [1]; TX buffer1 == TX buffer1 [1] loop_bytes = loop_bytes + 1 TX bytes1 = TX bytes1 - 1 %repeat %while TX bytes2 > 0 %cycle b = TX buffer2 b == b [1]; TX buffer2 == TX buffer2 [1] loop_bytes = loop_bytes + 1 TX bytes2 = TX bytes2 - 1 %repeat old SR = or to SR(station interrupts off) loop_next == inbound queue inbound queue == loop old SR = set SR(old SR) signal semaphore(inbound packet arrived) %finish; ! Else just drop the packet.... %else ! Interrrupts off and kick the station {L} lights or B(lights sending) old SR = or to SR(station interrupts off) %while status & td mask = 0 %cycle; %repeat control = DTX %while status & td mask = 0 %cycle; %repeat data = 0 ! Interrupts on again and wait for the packet to go old SR = set SR(old SR) semaphore wait(TX done) {L} lights and B(\lights sending) %finish %else printstring("Dud short TX request: "); write(m_bytes1, 0) printstring(" + ") %and write(m_bytes2, 0) %if m_bytes2 > 0 newline %finish signal semaphore(m_done) %repeat %end ! Old-style protocol handler. ! Protocol control blocks are accessed in one of two ways: from the user side ! they are accessed directly by indexing into the table, while from the ether ! side they are accessed indirectly via a table of chained blocks, one slot ! for each remote address. "Port 0" is slightly special-cased to set up the ! destination station and port and to register the existence of a recipient. ! Mostly it is just the same as the VC ports. %recordformat old protocol fm(%record(old protocol fm)%name next, %record(ether header fm) header, %integer reTX lives, next reTX, reTX interval, %integer last seq, last address, %record(RX buffer fm)%name pending packets, %record(ether request fm)%name pending reads, %record(ether request fm)%name pending writes) %ownrecord(old protocol fm)%array opcb(0 : old protocol slots) = 0(*) %ownrecord(old protocol fm)%namearray opsl(first station - 1 : last station) == nil(*) %ownrecord(semaphore fm) old protocol semaphore = 0 %record(old protocol fm)%map find inbound opcb(%record(ether header fm)%name h) %record(old protocol fm)%name p %result == nil %unless first station <= h_ss <= last station p == opsl(h_ss) !! printstring("Find inbound first at "); phex(addr(p)); newline %while p ## nil %cycle ! Do source/destinatiaon ports match? Source address for each ! pcb is implied by the list it's on. %result == p %if p_header_dp = h_sp %and p_header_sp = h_dp p == p_next !! printstring("Next at "); phex(addr(p)); newline %repeat %result == nil %end %routine copy out old style(%record(RX buffer fm)%name from, %record(ether request fm)%name to) %integer f, t %label L to_bytes = from_bytes - 14 %if to_bytes > 0 %start ! Beware null packets f = addr(from_data(15)) t = addr(to_buffer) D0 = to_bytes - 1; A0 = f; A1 = t L: *move.b (A0)+, (A1)+ *dbra D0, L %finish to_ra = from_header_ss to_rp = from_header_sp %end %routine do old write(%record(old protocol fm)%name p, %integer setup) %record(outbound message fm) m = 0 %record(semaphore fm) s = 0 !! printstring("Do old write: "); phex(addr(p)) !! write(setup, 1); write(p_pending writes_bytes, 1); newline {L} lights or B(lights old outbound) %if setup # 0 %start p_reTX lives = reTX lives p_reTX interval = 1 p_next reTX = timestamp + 2 %finish setup semaphore(s) setup message(m, size of(m)) %if p == opcb(0) %start ! Port 0, copy in ds and dp p_header_ds = p_pending writes_ra p_header_dp = p_pending writes_rp %finish m_buffer1 == p_header_ds; m_bytes1 = 14 m_buffer2 == p_pending writes_buffer m_bytes2 = p_pending writes_bytes m_done == s send message(m, outbound mailbox, nil) semaphore wait(s) old outbound packets = old outbound packets + 1 {L} lights and B(\ lights old outbound) %end %routine old inbound handler %ownrecord(outbound message fm) ACK mess = 0 %ownrecord(semaphore fm) ACK semaphore = 0 %ownrecord(ether header fm) ACK = 0 %record(RX buffer fm)%name buffer, RX pending %record(ether request fm)%name request pending %record(old protocol fm)%name p %integer i, n open input(3, ":N"); select input(3) open output(3, ":T"); select output(3) setup semaphore(ACK semaphore) setup message(ACK mess, size of(ACK mess)) {} printstring("Old-style inbound handler: "); write(free store, 0); newline %cycle {L} lights and A(\ lights old inbound) semaphore wait(old packet arrived) {L} lights or A(lights old inbound) semaphore wait(old queue semaphore) signal semaphore(old queue semaphore) %and %continue %c %if old inbound queue == nil; ! Spurious wake buffer == old inbound queue old inbound queue == buffer_next signal semaphore(old queue semaphore) %if buffer_header_ds = 0 %start ! Drop broadcasts release RX buffer(buffer) %continue %finish semaphore wait(old protocol semaphore) !! printstring("Old inbound at "); phex(addr(buffer)) !! printstring(" for "); write(buffer_header_dp, 0) !! printstring(", type "); phex2(buffer_header_type); newline %if buffer_header_dp = 0 %then p == opsl(first station - 1) %c %else p == find inbound opcb(buffer_header) %if p ## nil %start ! Connection is known. Is this inbound data or an ACK for ! something we've sent? %if buffer_header_type = old data type %start ! Data packet has arrived old inbound packets = old inbound packets + 1 !! printstring("Data arrived from "); phex2(buffer_header_ss) !! print symbol('.'); phex2(buffer_header_sp) !! printstring(", seq "); phex2(buffer_header_seq) !! printstring(", pcb at "); phex(addr(p)) !! newline ! First ACK the packet. !ACK = 0 ACK_ss = station address; ! Filled in by station anyway... ACK_sp = buffer_header_dp ACK_ds = buffer_header_ss ACK_dp = buffer_header_sp ACK_type = old ACK type ACK_seq = buffer_header_seq ACK mess_buffer1 == ACK_ds ACK mess_bytes1 = 14 ! Second part implictly zeroed already. ACK mess_done == ACK semaphore send message(ACK mess, outbound mailbox, nil) semaphore wait(ACK semaphore) ! Now if this packet's sequence number is new then we forward ! the data to the user or queue the buffer if there isn't ! a pending read. %if buffer_header_seq # p_last seq %c %or buffer_header_ss # p_last address %start p_last seq = buffer_header_seq p_last address = buffer_header_ss %if p_pending reads ## nil %start ! There's a user request waiting, so complete it. !! printstring("Pending user request"); newline request pending == p_pending reads p_pending reads == request pending_next copy out old style(buffer, request pending) request pending_status = ether success send message(request pending, request pending_system part_reply, nil) %c %if request pending_system part_reply ## nil %else ! No user-request waiting, so put this on the pending queue !! printstring("No pending user request"); newline buffer_next == nil %if p_pending packets == nil %start ! Queue empty p_pending packets == buffer %else ! Something else waiting RX pending == p_pending packets RX pending == RX pending_next %while RX pending_next ## nil RX pending_next == buffer %finish ! Now avoid dropping through, as if we did we would ! be releasing our newly-enqueued RX buffer.... signal semaphore(old protocol semaphore) %continue %finish %finish %else %if buffer_header_type = old ACK type ! ACK packet has arrived !! printstring("ACK arrived from "); phex2(buffer_header_ss) !! print symbol('.'); phex2(buffer_header_sp) !! printstring(", seq "); phex2(buffer_header_seq) !! printstring(", expecting "); phex2(p_header_seq) !! newline %if buffer_header_seq = p_header_seq %c %and buffer_header_ss = p_header_ds %start !! printstring("Expected ACK"); newline ! It's an ACK for the last thing we sent. First bump our ! send sequence number (avoiding 0, as cooked stations ! treat it as special). p_header_seq = (p_header_seq + 1) & 255 p_header_seq = 1 %if p_header_seq = 0 ! Now complete the first request on the pending write ! queue. %if p_pending writes ## nil %start !! printstring("Completing pending write"); newline request pending == p_pending writes p_pending writes == request pending_next request pending_status = ether success send message(request pending, request pending_system part_reply, nil) %c %if request pending_system part_reply ## nil do old write(p, 1) %if p_pending writes ## nil; ! Kick next !! %else !! printstring("Spurious ACK from "); phex2(buffer_header_ss) !! print symbol('.'); phex2(buffer_header_sp) !! printstring(", seq "); phex2(buffer_header_seq) !! newline %finish !! %else !! printstring("Unexpected ACK: expecting ") !! phex2(p_header_seq); printstring(" got ") !! phex2(buffer_header_seq); newline %finish !! %else !! ! Something bogus on the queue !! printstring("Something bogus arrived from ") !! phex2(buffer_header_ss) !! print symbol('.'); phex2(buffer_header_sp) !! printstring(", type "); phex2(buffer_header_type) !! printstring(", seq "); phex2(buffer_header_seq) !! newline %finish %else ! Else ignore it !! printstring("No takers for ") !! phex2(buffer_header_ss) !! print symbol('.'); phex2(buffer_header_sp) !! printstring(" -> "); phex2(buffer_header_ds) !! print symbol('.'); phex2(buffer_header_dp) !! printstring(", type "); phex2(buffer_header_type) !! printstring(", seq "); phex2(buffer_header_seq) !! newline old inbound no takers = old inbound no takers + 1 %finish signal semaphore(old protocol semaphore) release RX buffer(buffer) %repeat %end %routine old style ether request(%record(ether request fm)%name m) %record(old protocol fm)%name p, q %record(ether request fm)%name pw %record(RX buffer fm)%name RX buffer %integer i, j !! printstring("Ether request type "); phex2(m_code) !! printstring(", context "); write(m_context, 0); newline %if m_code = ether old define %start !! printstring("Define: RA "); phex2(m_ra) !! print symbol('.'); phex2(m_rp); newline old defines = old defines + 1 semaphore wait(old protocol semaphore) %unless first station <= m_ra <= last station %start m_status = ether dud destination !! printstring("Define dud destination"); newline %else m_context = 0 %for i = 1, 1, old protocol slots %cycle p == opcb(i) m_context = i %and %exit %if p_header_type = 0 %repeat %if m_context # 0 %start !! printstring("Free slot at "); write(m_context, 0); newline ! A free slot. Link it in. p = 0 %if opsl(m_ra) == nil %start ! Station list was empty !! printstring("Only one on list"); newline opsl(m_ra) == p p_next == nil %else ! Put on (head of) station list !! printstring("Link in front of ") !! phex(addr(opsl(m_ra))); newline p_next == opsl(m_ra) opsl(m_ra) == p %finish ! Find the lowest free local port j = 0 q == opsl(m_ra) %while q ## nil %cycle j = j ! (1 << q_header_sp) q == q_next %repeat %for i = 1, 1, 31 %cycle %if j & (1 << i) = 0 %start ! Found one free !! printstring("Assigning local port ") !! write(i, 0); newline p_header_sp = i m_lp = i %exit %finish ! Assume for now that this will always succeed! %repeat p_header_ss = station address p_header_ds = m_ra p_header_dp = m_rp p_header_type = old data type p_header_seq = timestamp & 255 p_header_seq = 1 %if p_header_seq = 0; ! Avoid 0!! p_last seq = -1 m_status = ether success !! printstring("Done, context "); write(m_context, 0) !! printstring(", LP "); phex2(m_lp); newline %else ! Must have been last slot, and in use. m_status = ether no free slots %finish %finish signal semaphore(old protocol semaphore) %else %if m_code = ether old redefine old redefines = old redefines + 1 semaphore wait(old protocol semaphore) %unless 0 < m_context <= old protocol slots %start m_status = ether dud context %else p == opcb(m_context) %if p_header_type = 0 %start ! Not in use m_status = ether dud context %else ! Change the port number of our peer. Remember to reset ! our send and receive sequence numbers. p_header_dp = m_rp p_header_seq = timestamp & 255 p_header_seq = 1 %if p_header_seq = 0; ! Avoid 0!! p_last seq = -1 m_status = ether success %finish %finish signal semaphore(old protocol semaphore) %else %if m_code = ether old undefine old undefines = old undefines + 1 semaphore wait(old protocol semaphore) %unless 0 < m_context <= old protocol slots %start m_status = ether dud context %else p == opcb(m_context) %if p_header_type = 0 %start ! Not in use m_status = ether dud context %else ! Clear down this slot. We have to release any pending receive ! buffers and return any pending user requests with an error ! status. Finally, we have to unlink the pcb from the chain ! of per-station blocks. ! First off, get rid of any pending RX buffers, so that they ! can be reused by the interrupt handler. %while p_pending packets ## nil %cycle RX buffer == p_pending packets p_pending packets == RX buffer_next release RX buffer(RX buffer) %repeat ! Pending read and write requests next... Complete these ! in the order in which they were queued, in case it matters ! to the caller. %while p_pending reads ## nil %cycle pw == p_pending reads p_pending reads == pw_next pw_status = ether operation aborted send message(pw, pw_system part_reply, nil) %c %if pw_system part_reply ## nil %repeat %while p_pending writes ## nil %cycle pw == p_pending writes p_pending writes == pw_next pw_status = ether operation aborted send message(pw, pw_system part_reply, nil) %c %if pw_system part_reply ## nil %repeat ! Finally, unlink us from the per-station chain i = p_header_ds %if first station <= i <= last station %start %if opsl(i) == p %start ! We're the first on the chain opsl(i) == p_next %else ! We're not first in the chain, so follow it down... q == opsl(i) q == q_next %while q_next ## nil %and q_next ## p %if q == nil %start printstring("Slow PCB "); write(m_context, 0) printstring(" not in chain for "); phex2(i) newline %else q_next == p_next %finish %finish %else printstring("Dud ether address "); phex2(i) printstring(" in slow PCB "); write(m_context, 0) newline %finish ! Finally, clear it down just to be sure p = 0 m_status = ether success %finish %finish signal semaphore(old protocol semaphore) %else %if m_code = ether old read old reads = old reads + 1 m_timeout = m_timeout + timestamp %if m_timeout > 0 semaphore wait(old protocol semaphore) %unless 0 <= m_context <= old protocol slots %start m_status = ether dud context %else p == opcb(m_context) %if p_header_type = 0 %start ! Undefined m_status = ether dud context %else ! There are two possible cases here: either there is a ! packet waiting for someone to read it, or there are ! no packets waiting and instead a queue of (zero or more) ! read requests waiting. %if p_pending packets == nil %start ! No pending packets. Enqueue our read on the end of ! the wait queue. m_next == nil %if p_pending reads == nil %start p_pending reads == m %else pw == p_pending reads pw == pw_next %while pw_next ## nil pw_next == m %finish signal semaphore(old protocol semaphore) %return; ! Inbound process will complete it. %else ! A packet awaits a reader. By implication, there ! will be no read requests pending..... RX buffer == p_pending packets p_pending packets == RX buffer_next copy out old style(RX buffer, m) release RX buffer(RX buffer) m_status = ether success %finish %finish %finish signal semaphore(old protocol semaphore) %else %if m_code = ether old write old writes = old writes + 1 %unless 0 <= m_context <= old protocol slots %start m_status = ether dud context %else %unless 0 < m_bytes <= ether packet size - 14 m_status = ether operation undefined %else semaphore wait(old protocol semaphore) p == opcb(m_context) %if p_header_type = 0 %start ! Undefined m_status = ether dud context %else m_next == nil %if p_pending writes == nil %start p_pending writes == m do old write(p, 1) %else ! Something already going, so just enqueue this one pw == p_pending writes pw == pw_next %while pw_next ## nil pw_next == m %finish signal semaphore(old protocol semaphore) %return; ! Inbound process will complete it... %finish signal semaphore(old protocol semaphore) %finish %else %if m_code = ether old register0 old defines = old defines + 1 semaphore wait(old protocol semaphore) %if opsl(first station - 1) == nil %start ! Not yet defined p == opcb(0) p = 0 p_header_ss = station address p_header_type = old data type p_header_seq = timestamp & 255 p_header_seq = 1 %if p_header_seq = 0; ! Avoid 0!! p_last seq = -1 ! ds & dp filled in on per-TX basis opsl(first station - 1) == p m_status = ether success %else ! Already registered m_status = ether operation undefined %finish signal semaphore(old protocol semaphore) %else %if m_code = ether old unregister0 old undefines = old undefines + 1 semaphore wait(old protocol semaphore) %if opsl(first station - 1) == nil %start ! Undefined m_status = ether operation undefined %else opsl(first station - 1) == nil ! First off, get rid of any pending RX buffers, so that they ! can be reused by the interrupt handler. %while p_pending packets ## nil %cycle RX buffer == p_pending packets p_pending packets == RX buffer_next release RX buffer(RX buffer) %repeat ! Pending read and write requests next... Complete these ! in the order in which they were queued, in case it matters ! to the caller. %while p_pending reads ## nil %cycle pw == p_pending reads p_pending reads == pw_next pw_status = ether operation aborted send message(pw, pw_system part_reply, nil) %c %if pw_system part_reply ## nil %repeat %while p_pending writes ## nil %cycle pw == p_pending writes p_pending writes == pw_next pw_status = ether operation aborted send message(pw, pw_system part_reply, nil) %c %if pw_system part_reply ## nil %repeat m_status = ether success %finish signal semaphore(old protocol semaphore) %else m_status = ether operation undefined %finish send message(m, m_system part_reply, nil) %if m_system part_reply ## nil %end %routine old timeout handler %record(old protocol fm)%name p %record(ether request fm)%name r, lr, n %integer i open input(3, ":N"); select input(3) open output(3, ":T"); select output(3) {} printstring("Old timeout handler: "); write(free store, 0); newline %cycle semaphore wait(clock semaphore) !%continue %unless timestamp & 15 = 0 ! Each time we are wakened we scan the pcb table looking for ! user timeouts and retransmit timeouts expiring. semaphore wait(old protocol semaphore) %for i = first station - 1, 1, last station %cycle p == opsl(i) %while p ## nil %cycle %if p_header_type # 0 %start !! write(timestamp, 0); printstring(" station "); phex2(i) !! printstring(", PW "); phex(addr(p_pending writes)) !! printstring(", lives "); write(p_reTX lives, 0) !! printstring(", next "); write(p_next reTX, 0) !! printstring(", interval "); write(p_reTX interval, 0) !! newline ! In use. First retransmit any pending write requests. %if p_pending writes ## nil %c %and p_next reTX <= timestamp %start ! First pending write's timeout has expired. p_reTX lives = p_reTX lives - 1 %if p_reTX lives <= 0 %start ! Not ACKed, return an error to user. old ACK timeouts = old ACK timeouts + 1 !! phex(addr(r)); printstring(" not ACKed"); newline r == p_pending writes p_pending writes == r_next; ! Unlink it r_status = ether timeout send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil ! Transmit the next on the queue, if any do old write(p, 1) %if p_pending writes ## nil; ! Kick next %else !! printstring("ReTX "); phex(addr(p)); newline old retransmits = old retransmits + 1 p_reTX interval = p_reTX interval << 1 p_next reTX = timestamp + p_reTX interval {L} lights or B(lights old reTX) do old write(p, 0) {L} lights and B(\ lights old reTX) %finish %finish ! Now check for expired read timeouts. lr == nil; r == p_pending reads %while r ## nil %cycle %if 0 < r_timeout <= timestamp %start ! This one's specified timeout has expired. Unlink ! it and send back an error message old user timeouts = old user timeouts + 1 !! phex(addr(r)); printstring(" user timeout"); newline n == r_next; ! Note the next one before we send this back. r_status = ether timeout send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil ! Now set up for the next one r == n %if lr == nil %then p_pending reads == r %c %else lr_next == r %else ! No timeout specified, or not expired yet. On ! to the next one. lr == r r == r_next %finish %repeat %finish p == p_next %repeat %repeat opcb(0)_last seq = -1 %if timestamp & 63 = 0; ! Nasty frig for cooked stations signal semaphore(old protocol semaphore) %repeat %end ! General protocol handler %routine ether request(%record(ether request fm)%name m) %record(RX buffer fm)%name RX %record(ether request fm)%name r, last r %record(icb fm)%name icb %record(ether header fm) header %record(outbound message fm) om = 0 %record(semaphore fm) os = 0 !! printstring("Ether request: "); phex2(m_code) !! space; phex(m_tag); space; phex2(m_type) !! space; write(m_bytes, 0); space; phex2(m_ra); newline %unless 2 <= m_type <= last registered %start m_status = ether dud context send message(m, m_system part_reply, nil) %c %if m_system part_reply ## nil %finish icb == icbs(m_type) semaphore wait(icb semaphore) %if m_code = ether read %start %if icb_active = 0 %start signal semaphore(icb semaphore) m_status = ether dud context send message(m, m_system part_reply, nil) %c %if m_system part_reply ## nil %return %finish %if icb_pending packets == nil %start ! Nothing waiting, we'll have to queue !! printstring("Read: must queue"); newline m_next == nil %if icb_pending reads == nil %start icb_pending reads == m %else last r == icb_pending reads last r == last r_next %while last r_next ## nil last r_next == m %finish signal semaphore(icb semaphore) %else ! Take the first pending packet !! printstring("Read: take first"); newline RX == icb_pending packets icb_pending packets == RX_next signal semaphore(icb semaphore) copy out(RX, m) release RX buffer(RX) m_status = ether success send message(m, m_system part_reply, nil) %c %if m_system part_reply ## nil %finish %else %if m_code = ether write %unless 0 < m_bytes <= ether packet size - 14 %start signal semaphore(icb semaphore) m_status = ether operation undefined send message(m, m_system part_reply, nil) %c %if m_system part_reply ## nil %return %finish %if icb_active = 0 %start signal semaphore(icb semaphore) m_status = ether dud context send message(m, m_system part_reply, nil) %c %if m_system part_reply ## nil %return %finish signal semaphore(icb semaphore) header = 0 header_ds = m_ra header_dp = 255 header_ss = station address header_sp = 255 header_type = m_type header_seq = 255 setup semaphore(os) setup message(om, size of(om)) om_buffer1 == header_ds; om_bytes1 = 14 om_buffer2 == m_buffer; om_bytes2 = m_bytes om_done == os send message(om, outbound mailbox, nil) semaphore wait(os) m_status = ether success send message(m, m_system part_reply, nil) %if m_system part_reply ## nil %else %if m_code = ether register %if icb_active # 0 %start signal semaphore(icb semaphore) m_status = ether dud context send message(m, m_system part_reply, nil) %c %if m_system part_reply ## nil %return %finish icb_active = 1 signal semaphore(icb semaphore) m_status = ether success send message(m, m_system part_reply, nil) %if m_system part_reply ## nil %else %if m_code = ether unregister %if icb_active = 0 %start signal semaphore(icb semaphore) m_status = ether dud context send message(m, m_system part_reply, nil) %c %if m_system part_reply ## nil %return %finish ! Release all pending packets %while icb_pending packets ## nil %cycle RX == icb_pending packets icb_pending packets == RX_next release RX buffer(RX) %repeat ! Return any pending read requests in the order they were queued %while icb_pending reads ## nil %cycle r == icb_pending reads icb_pending reads == r_next r_status = ether operation aborted send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil %repeat ! Mark inactive and release the icb icb_active = 0 signal semaphore(icb semaphore) ! Finally send the request back with a success code m_status = ether success send message(m, m_system part_reply, nil) %if m_system part_reply ## nil %else signal semaphore(icb semaphore) m_status = ether operation undefined send message(m, m_system part_reply, nil) %if m_system part_reply ## nil %finish %end ! Main program -- take user requests and call one or other of the old-style ! or general protocol handlers %begin %record(process fm)%name p %ownrecord(mailbox fm) mailbox = 0 %ownrecord(semaphore fm) semaphore = 0 %record(ether request fm)%name m %label start inbound handler, start outbound handler %label start old inbound handler, start old timeout handler open input(2, ":N"); select input(2) open output(2, ":T"); select output(2) setup semaphore(clock semaphore) start ticking setup semaphore(inbound packet arrived) setup semaphore(TX done) setup semaphore(outbound semaphore) setup mailbox(outbound mailbox, outbound semaphore) setup semaphore(icb semaphore) signal semaphore(icb semaphore) setup semaphore(old packet arrived) setup semaphore(old queue semaphore) signal semaphore(old queue semaphore) setup semaphore(old protocol semaphore) signal semaphore(old protocol semaphore) setup semaphore(semaphore) setup mailbox(mailbox, semaphore) setup RX free list setup station handler p == create process(inbound handler size, addr(start inbound handler), inbound handler priority, nil) p == create process(outbound handler size, addr(start outbound handler), outbound handler priority, nil) p == create process(old inbound handler size, addr(start old inbound handler), old inbound handler priority, nil) p == create process(old timeout handler size, addr(start old timeout handler), old timeout handler priority, nil) FS insert(ether mailbox name, addr(mailbox)) FS insert("SLOW_ETHER_ADDRESS", station address); ! NB: not pointer {} printstring("Slow ether: "); write(free store, 0) {} printstring(" free"); printstring(", station ") {} phex2(station address); newline {L} lights and A(\ lights clear) {L} lights and B(\ lights clear) %cycle m == receive message(mailbox) %if m_code & ether old operation # 0 %start {L} lights or A(lights type) old style ether request(m) {L} lights and A(\ lights type) %else %if m_code & ether operation # 0 {L} lights or B(lights type) ether request(m) {L} lights and B(\ lights type) %else %if m_code = ether stats m_stats_station address = station address m_stats_buffer low water = buffer low water m_stats_pended DTX = pended DTX m_stats_unrecognised control = unrecognised control m_stats_inbound packets = inbound packets m_stats_inbound bytes = inbound bytes m_stats_outbound packets = outbound packets m_stats_outbound bytes = outbound bytes m_stats_dud destinations = dud destinations m_stats_dud types = dud types m_stats_old inbound packets = old inbound packets m_stats_old outbound packets = old outbound packets m_stats_old inbound no takers = old inbound no takers m_stats_old retransmits = old retransmits m_stats_old ACK timeouts = old ACK timeouts m_stats_old user timeouts = old user timeouts m_stats_old defines = old defines m_stats_old redefines = old redefines m_stats_old undefines = old undefines m_stats_old reads = old reads m_stats_old writes = old writes m_status = ether success send message(m, m_system part_reply, nil) %c %if m_system part_reply ## nil %else %if m_code = ether station address m_context = station address m_status = ether success send message(m, m_system part_reply, nil) %c %if m_system part_reply ## nil %else m_status = ether operation undefined send message(m, m_system part_reply, nil) %c %if m_system part_reply ## nil %finish %repeat start inbound handler: inbound packet handler start outbound handler: outbound packet handler start old inbound handler: old inbound handler start old timeout handler: old timeout handler %end %of %program