! file 'node_prt12us' !********************* !* prt12s/prt12y * !*version for node * !!!!!!!!!!!!!!!!!!!!!! !stack = 400 %control 1 %include "deimosperm" %constinteger kernel ser = 29 ! %owninteger secondary = 0; !prim = 0, sec = 1 %constintegername secad == k'060016'; ! in buffer seg, set by node %constinteger wmax = 56; ! max no of writes %constinteger sfmask = 63; ! circ buffer size for writes %conststring (13) vsn = "prtn:vsn012r " #datestring; ! use prep on this %begin %recordformat xxf(%integer dummy) %recordformat parf(%integer type, %c (%record (xxf) %name b %or %integer address), %c %integer len) %routinespec dqs11e(%record (parf) %name l) %routinespec umc1e(%record (parf) %name b) %owninteger line = 0; !logical line %constintegername no of buff == k'060112'; ! no of buffers (buff3) %owninteger big limit = 7; ! try at 5 for now %owninteger critical = 8; ! no to return buffers at %owninteger max reads = 10; ! max it is allowed to hold %constinteger initialise = 0; ! calls & replies to line handler routines %constinteger line input = 1 %constinteger line output = 2 %constinteger input here = 3 %constinteger output done = 4 %constinteger input req = 1; ! interface to higher level %constinteger output req = 2 %constinteger bounce = 3 %constinteger put down = 4 %constinteger put up = 5 %constinteger monit = 6 %constinteger varbs address = 7 %constinteger buffer manager = 17 %owninteger rx int = -7, tx int = -6 %recordformat mef(%byteinteger hlen, htype, len, type, %c %byteintegerarray a(0:240)) %recordformat hdlcf(%byteinteger add, type) %recordformat mef2(%byteinteger hlen, htype, %record (hdlcf) hdlc) %recordformat pe(%byte ser, reply, (%byte fn, line, %c %record (mef) %name m, %byte len, s1 %or %integer a, b, c)) %ownrecord (parf) par %ownrecord (pe)p %integer i, f %owninteger input exp; ! no of buffers in private q %owninteger demand = 0; ! no of lines awaiting buffer %owninteger demandx = 0; ! total no of demands %owninteger part tick, act no of lines, max q timer, buff held %recordformat wdse(%record (mef2) %name m) %recordformat parmf(%byteinteger err, ext, %integer addr, len) !******************************************************* !! do not change the order or position of the following varbs %recordformat linef(%byte istate, rstate, q max, w pend,%c dcou, dsym, %integer %c ird, rrrd, rnr rd, rej rd, i tr, rr tr, rnr tr, rej tr, %c badack, bad fr, silofull, dm, i re tr, crc fail, itrh, %c aaa, eee, fff, ttt, %c %byte clock0, clock1, clock2, clock3, clock4, clock5, clock6, %c %byte tstate, rr time, line type, active, secondary, abort req, %c qq max, %c (%record (xxf) %name handler address %or %integer in addr), %c %record (hdlcf) om, %record (parmf) ipar, opar, %c %record (wdse) %array wspace(0:sfmask)) !a..last message acknowledged ! by other end !e..number of next message ! expected !f..last output message held+1 !t..last message sent !clock1. cleared when ack ! received, and when retry starts ! timed when ack ! outstanding !clock2. time since valid ! message from other end !clock3. no of transmit ! retries. cleared when ack ! received !clock. time since rr or sarm !clock6. q too long time !************************************************************** %recordformat rdse(%record (mef2) %name m, %integer len) %recordformat bpf(%record (mef2) %name m) %constinteger no of lines = 33; ! max number of handlable lines-1 %ownrecord (linef) %array linea(0:no of lines) %ownrecord (linef) %name l %ownrecord (wdse) %name wdesc %ownrecord (rdse) icurr %ownrecord (rdse) %name ipool %ownrecord (bpf) %name me2 %ownbyteintegerarray intx(-90:0) = 255(*) %owninteger mon = 0; ! -1 = on, 0 = off %constbyteintegername change out zero == k'160310' %constinteger t3 ser = 21 %constbyteintegerarray init(0:1) = 4, 2; ! initial state of istate %ownintegerarray raddr(0:7) %switch sw(input req: varbs address) %routinespec reinitialise %routinespec set input %routine octal(%integer n) %integer i printsymbol((n >> i)&7+'0') %for i = 15, -3, 0 %end %routine tell printstring("prot"); write(line, 1); printsymbol(':') %end %routine start input par_type = line input; par_b == icurr_m_hdlc; par_len = icurr_len %if mon < 0 %start select output(1) tell; printstring("Inp:"); octal(addr(par_b)); newline select output(0) %finish %if l_line type = 0 %start dqs11e(par) %finish %else %if l_line type = 1 %start umc1e(par) %finish %end %routine wreply(%integer flag, block) p_ser = kernel ser; p_reply = id p_fn = output req; p_b = block; p_c = flag p_line = line !! monitor(p) pon(p) %end %routine check demand %integer i %cycle i = 0, 1, no of lines %if linea(i)_clock5 # 0 %start l == linea(i) line = i; ! used globally (line number) set input; ! put a buffer as input demand = demand-1 %return %finish %repeat demand = 0 %end %routine got buffer %integer i me2 == p_m me2_m == ipool ipool == me2 input exp = input exp+1 %if demand > 0 %then check demand %end %routine return buff %record (wdse) %name me2 %record (pe) p p_ser=buffer manager; p_reply=id p_a=1; p_m == wdesc_m p_m_type = wdesc_m_htype %if p_m_type # 0 %or input exp >= max reads %or no of buff %c < critical %start p_m_a(4) = k'123' pon(p) buff held = buff held-1 %else me2 == p_m me2_m == ipool ipool == me2 input exp = input exp+1 %finish %end %routine ask for buffer p_ser = buffer manager; p_reply = id p_a = 0; p_c = 0; ! ask for big buffer pon(p) %end %routine monitor line stats tell; write(l_istate, 4); write(l_rstate, 4) write(input exp, 5); write(l_w pend, 4) write(l_q max, 4); l_qmax = 0; spaces(4) write(l_dcou, 4); write(l_dsym, 4); write(l_active,4);!nsm special write(l_qq max, 4) newline tell; write(l_ird, 4);write(l_rrrd, 4);write(l_rnrrd, 4);write(l_rejrd, 4) write(l_itr,6);write(l_rrtr, 4); write(l_rnr tr, 4) write(l_rejtr, 4); newline tell; write(l_badack, 4);write(l_badfr, 4);write(l_silofull, 4);write(l_dm, 4) write(l_i re tr-l_itr, 5) write(l_crc fail, 5) newline %end %routine set input %if input exp > 0 %start l_clock5 = 0 icurr_m == ipool ipool == ipool_m; input exp = input exp-1 icurr_m_htype = icurr_m_hdlc_type icurr_len =252 start input; ! and get the input going %else demand = demand+1; l_clock5 = 1; ! wait for buffer demandx = demandx+1 %finish %end %routine abort(%integer type) ! reasons for abort: !1..nothing valid received in ! 40 ticks !2..10 retries to re-transmit !3..device handler fault !4..reset from brian !6..sarm received from primary !7..no reads onfor 24 tries !8..too many writes (ie full up) %integer x, i %if l_abortreq = 0 %start tell; printstring("dead ") printsymbol(type+'0') newline wreply(1, 0); !tell gate down !set restrictive condition %finish %if l_active = 2 %start l_abortreq = 1 %else l_abortreq = 0 !tidy up requests x = 0 %while l_aaa # l_fff %cycle; !tidy up requests wdesc == l_wspace(l_aaa) return buff x = x+1 %if x&7=7 %then set prio(2) wdesc_m == null l_aaa = (l_aaa+1)&sfmask %repeat tell; printstring("buff freed ="); write(x, 1); newline l_w pend = 0 l_istate = init(l_secondary) %unless l_istate = 10 %finish %end %routine handle output %record (hdlcf) %name hdlc %record (mef2) %name m %integer type, len %returnif l_active # 0; !abort if transmitter busy %if l_abort req # 0 %then abort(0) %if l_istate # 0 %start; ! in initial sequence %if l_istate = 4 %start; ! send sarm l_istate = 3; ! goes back to 4 after l_clock tick type = x'0f'; !sarm -> send1 %finish %if l_istate = 1 %start; ! ready to send ua l_istate = 0 type = x'63'; !ua -> send1 %finish %return; ! l_istate#above values %finish %if l_rstate = 3 %start l_rstate = 2 l_rej tr = l_rej tr+1 type = 9; !l_rej -> send %finish %if l_rstate = 6 %start; ! send l_rnr type = 5 l_rnr tr = l_rnr tr+1 l_rstate = 5; ! get it to send rr if possible -> send %finish %if l_ttt # l_fff %and l_tstate = 0 %c %and (l_ttt-l_aaa)&7#5 %start wdesc == l_wspace(l_ttt) m == wdesc_m; hdlc == m_hdlc len = m_hlen+2 type = l_eee << 5+(l_ttt&7) << 1 l_ttt = (l_ttt+1)&sfmask l_active = 2; !big block being transmitted l_clock1 = 0; !set timer l_i re tr = l_i re tr+1; ! total no of i frames tr -> put %finish %if l_rstate = 1 %or (l_rstate = 2 %and l_clock0 >= 5) %start l_rstate = 0 %if l_rstate = 1 type = 1; !rr l_rr tr = l_rr tr+1 %finish %else %return !! send: type = l_eee << 5+type send1: hdlc == l_om len = 2 l_active = 1; !short block being transmitted put: l_clock0 = 0 hdlc_add = secad; hdlc_type = type par_type = line output; par_b == hdlc; par_len = len %if mon < 0 %start select output(1) tell; printstring("Out "); octal(addr(par_b)); newline select output(0) %finish %if l_line type = 0 %start dqs11e(par) %finish %else %if l_line type = 1 %start umc1e(par) %finish %end !! %routine handle input %record (hdlcf) %name hdlc %record (mef2) %name m %integer r, s, x, type m == record(addr(par_b)-2); ! p_b -> hdlc part hdlc == par_b icurr_m == m; ! get rid of icurr completely ! %if mon < 0 %start select output(1) spaces(8); tell; printstring("Inb "); octal(addr(m)); newline select output(0) %finish ! par_len<0 buffer too small %if par_len < 0 %start %if par_len = -1 %start l_dm = l_dm+1 l_clock4 = l_clock4+1 %if l_clock4>24 %then abort(7) %finish %else %if par_len = -2 %start l_bad fr = l_bad fr+1 %finish %else %if par_len = -3 %start l_silo full = l_silo full+1 %finish %else %if par_len = -4 %start l_crc fail = l_crc fail+1; l_bad fr = l_bad fr+1 %finish -> noise %finish type = hdlc_type&x'ef'; ! ignore poll -> noise %if l_abort req # 0 %if l_istate # 0 %start -> noise %if l_istate = 10 ! keep down if no reads or line meant to be down l_dcou = l_dcou+1; l_dsym = type; ! retain for monitoring %if type = x'0f' %start; ! sarm seen %if l_secondary = 1 %or secad > hdlc_add %start l_istate = 1; ! send ua %finish %else -> noise; ! ignore it %else -> noise %unless l_secondary = 0 %and type = x'63' l_istate = 0; ! all done %finish l_rstate = 1; ! send rr l_tstate = 0 l_aaa = 0; l_eee = 0; l_fff = 0; l_ttt = 0 l_clock1 = 0; l_clock2 = 0; !reset l_clocks l_clock3 = 0 wreply(0!(hdlc_add<<8), 0); !tell noel up l_w pend = 0 -> end3 %finish %if type = x'0f' %start %if l_clock2 >= 15 %start !sarm received & this is ! l_secondary abort(6); !sarm received %finish -> noise %finish r = (type >> 5)&7 type = type&15 %if type&1 = 0 %start; !information block s = type >> 1 %if s # l_eee %start l_rstate = 3 %unless l_rstate = 2 !l_reject if not already set -> end1 %finish !pass message up p_ser = kernel ser; p_reply = id p_fn = input req; p_line = line p_m == m p_m_type = m_htype p_m_len = par_len-2 buff held = buff held-1 %if 0 # p_m_type # 64 %start printstring("prot: grotted ") %finish pon(p) l_i rd = l_i rd+1 hdlc == null; !no current buffer l_eee = (l_eee+1)&7 %if l_rstate = 5 %then l_rstate = 1 %else l_rstate = 5 !! send rr if 2 outstanding, else wait and see %if no of buff < big limit %then l_rstate = 6; ! send l_rnr %else %if type = 1 %start; !rr l_tstate = 0 l_rr rd = l_rr rd+1 %else %if type = 5 %start; !l_rnr l_tstate = 1 l_rnr rd = l_rnr rd+1 %else %if type = 9 %start ! 9=l_rej l_rej rd = l_rej rd+1 %else tell; printstring("noise"); write(HDLC_ADD, 1) wRITE(HDLC_TYPE, 1) newline -> noise %finish; %finish; %finish %finish !! end1: !check acknowledgement x = l_aaa %while x&7 # r %cycle %if x = l_ttt %start; !no ack expected l_bad ack = l_bad ack+1 -> end3 %finish x = (x+1)&sfmask %repeat %unless l_active = 2 %and x = l_ttt %start !ignore ack for block !currently being transmitted !update a counter %while l_aaa # x %cycle wdesc == l_wspace(l_aaa) return buff l_i tr = l_i tr+1 wdesc_m == null l_w pend = l_w pend-1; !count down transmit requests l_aaa = (l_aaa+1)&sfmask l_clock1 = 0; l_clock3 = 0 %repeat %if type = 9 %then l_ttt = l_aaa; !l_rej..reset transmit count %finish end3: !valid message l_clock2 = 0; !reset validity timer noise: %if %not hdlc == null %start %if l_istate = 10 %start wdesc == icurr; ! map to it for return buff return buff %return %finish !! use the same one again start input %else %return %if l_istate = 10; ! hold it down set input %finish %if input exp<2 %then ask for buffer; ! watch it ************************ handle output %end %routine clock int %integer flag l_clock0 = l_clock0+1 %if l_istate # 0 %start %return %if l_clock0 < 5 %or l_istate = 10 l_istate = init(l_secondary); !send another sarm %else l_clock2 = l_clock2+1 %if l_clock2 >= 80 %start !nothing from other end in 80 ! ticks flag = 1 -> labort %finish %if l_w pend > 5 %start %if l_clock6 = 0 %then l_itrh = l_itr; ! check thruput l_clock6 = l_clock6+1 %if l_clock6 > 60 %start; ! just over 1/2 min %if 0 <= l_itr-l_itrh <= 5 %start tell; printstring("*** no thruput ") l_active = 0; ! force transmitter to idle l_opar_addr = 0; ! clear buffer (nb: LOSES a BUFFER) flag = 8; ->labort; ! do abort 8 %finish %else l_clock6 = 0 %finish %finish %else l_clock6 = 0; ! no q, so reset l_clock6 ! %if l_active # 0 %start; ! output in progress ! lost int = lost int+1; ! test for lost interrupts ! %if lost int = 20 %and l_istate = 0 %start; ! give it 5 secs to transmit the block ! tell!; printstring("******** missing interrupt ********** !") ! free input buff ! reinitialise ! %finish ! %finish %if l_aaa # l_ttt %then l_clock1 = l_clock1+1 %if l_clock1 > l_rr time %and l_aaa # l_ttt %and l_tstate = 0 %start l_clock3 = l_clock3+1; !count retries %if l_clock3 > 30 %start flag = 2 -> labort %finish l_clock1 = 0 l_ttt = l_aaa; !reset transmit count %else %if l_clock0 > l_rr time %start; !send another rr l_rstate = 6 %if no of buff < big limit; ! priority ??? l_rstate = 1 %if l_rstate = 0 %or l_rstate = 5 %else %return !! labort: abort(flag); !1..nothing valid in 40 ! ticks..2..10 retries to ! retransmit %finish; %finish; %finish handle output %end !! %routine reinitialise !! grabs the interrupt service nos and sets/resets the device %integer i %cycle i = -90, 1, 0; ! all interrupt numbers %if intx(i)&127 = line %then linkin(i) %repeat %if l_ipar_addr # 0 %start; ! still a read on ! tell; printstring("Input still active:"); octal(l_in addr) space; octal(l_ipar_addr); newline %if l_line type # 0 %then %c icurr_m == record(l_in addr-2) %else icurr_m == record(l_ipar_addr-2) wdesc == icurr return buff %finish par_type = initialise par_b == l_handler address par_len = line %if l_line type = 0 %start dqs11e(par) %else umc1e(par) %finish l_clock5 = 1; demand = demand+1 l_active = 0; l_abort req = 0 %end !! i = map virt(buffer manager, 4, 3) i = map virt(buffer manager,5,4) i = map virt(buffer manager, 6, 5) change out zero = t3 ser printstring(vsn); printstring(datestring); newline %cycle i = 3, 1, 6; ! find absolute addresses raddr(i) = map abs(i<<13, 256, id); ! my addresses f = map abs(i<<13, 0, id); ! and off again %repeat map hwr(0) %cycle p_ser = 0; poff(p); ! wait for instructions %exit %if p_fn = 255; ! end of lines line = p_fn l == linea(line) l_line type = p_line&7 l_handler address == p_m rxint = p_len!x'ff00'; txint = p_s1!x'ff00' i = p_line>>4&3 l_rr time = 2 %if i = 1 %then l_rr time = 3; ! l_line type = x'10' = low priority ! %if i = 2 %then int = 'H'; ! l_line type = x'20' = high %if p_line&k'40' # 0 %then %c l_istate = 10 %else l_istate = init(l_secondary) !! if any of bits 3-5 is set, line is held down intx(rxint) = line+128 intx(txint) = line %repeat act no of lines = line %cycle line = 0, 1, act no of lines l == linea(line) %if l_rr time # 0 %start reinitialise wreply(2, 0); ! say 'here i am' to kernal %finish %repeat alarm(25) ask for buffer %for i = 1, 1, 15 set prio(2) %cycle check demand %if demand > 0 %and input exp > 0; ! have buffer will use p_ser = 0 poff(p) %if p_ser&x'80' # 0 %start; ! interrupt line = intx(p_ser!x'ff00') %if line&128 # 0 %then line = line-128 %and i = input here %c %else i = output done l == linea(line) par_type = i %if l_line type = 0 %start dqs11e(par) %finish %else %if l_line type = 1 %start umc1e(par) %finish %if par_type = line output %start l_dm = l_dm+1 %if par_len < 0 %if mon < 0 %start select output(1) spaces(8); tell; printstring("Oub "); newline select output(0) %finish l_active = 0; handle output %else handle input %finish %continue %finish %if p_reply = 0 %start alarm(5); ! period is split into 5 parts %cycle part tick = part tick, 1, part tick+5 %if part tick > act no of lines %then %continue l == linea(part tick) line = part tick clock int %unless l_rr time = 0; ! not really in use %if max q timer = 66 %start l_qq max = l_q max; l_q max = l_w pend %finish %repeat %if part tick > no of lines %start part tick = 0 max q timer = max q timer+1 %if max q timer > 66 %then max q timer = 0 %finish %if demand > 0 %and no of buff > critical %then ask for buffer %if 'M' <= int <= 'O' %start mon = int-'O'; int = 0 %finish %if int = '?' %start int = 0 printstring("Internal q ="); write(input exp, 1) printstring(", buff held tot ="); write(buff held, 1) printstring(", demanded ="); write(demand, 1) printstring(", total demanded ="); write(demandx, 1) newline %finish %if int = 'L' %start; ! lower priority max reads = max reads-2; big limit = big limit+2 critical = critical+2 int = 0 %finish %if int = 'H' %start; ! higher priority max reads=maxreads+2; biglimit=biglimit-2;critical=critical-2 int = 0 %finish %continue %finish %if p_reply = buffer manager %start; ! buffer has arrived buff held = buff held+1 got buffer %continue %finish !! user request line = p_line l == linea(line) -> sw(p_fn) sw(output req): !write req %if l_istate = 0 %start l_w pend = l_w pend+1; ! count pending writes %if l_w pend > l_q max %then l_q max = l_w pend buff held = buff held+1 %if l_w pend = wmax %start tell; printstring("full!") abort(8); ! full up %continue %finish wdesc == l_wspace(l_fff) wdesc_m == p_m wdesc_m_htype = p_m_type wdesc_m_hlen = p_len l_fff = (l_fff+1)&sfmask handle output; !kick transmit %else; ! not up, so discard sw(input req): ! being phased out p_ser = buffer manager; p_reply = id p_a = 1 pon(p) %finish %continue sw(bounce): ! force line bounce abort(4) %continue sw(put down): ! force and hold down abort(4); l_istate = 10 %continue sw(put up): ! allow it up again l_istate = init(l_secondary) reinitialise; ! grab interrupts and reset device ! may have been down line loaded %continue sw(monit): monitor line stats %continue sw(varbs address): p_ser = p_reply; p_reply = id p_a = 0; ! type is protocol handler p_b = addr(l_istate); ! plant address pon(p) %repeat ! ! file 'umc1e' ! file 'fep_umc1e' !************** !* umc1e * !*da:09.jul.81* !************** ! %recordformat parf(%integer type, address, len) %routine umc1e(%record (parf) %name p) %recordformat pf(%byteinteger ser, reply, %integer a, b, c) %record (pf) px %recordformat umc11f(%integer csr, %integerarray spare(0:2), bit(0:7), %c %byteinteger fn, ext, %integer addr, len) %constrecord (umc11f) %name umc == k'006740' %constinteger umc control = 18 ! %recordformat parmf(%byteinteger err, ext, %integer addr, len) %constinteger initialise = 0 %constinteger line input = 1 %constinteger line output = 2 %constinteger input here = 3 %constinteger output done = 4 %constinteger modem status = 5 %integer x, rx bit, tx bit, bit wordp %integername umc word %switch typesw(initialise:modem status) %integer type, f, cad, oseg, i, ext bits %integer par, pad ! now work out where the pair of bits are ! ! one rx bit and one tx bit, 8 lines per word, alternate words rx bit = 1<<((line&7)<<1) tx bit = rx bit << 1 umc word == umc_bit((line>>3)*2) -> type sw(p_type) type sw(initialise): px_ser = umc control; px_reply = id px_a = line px_b = addr(l_i par); px_c = addr(l_o par) ponoff(px) %if px_a # 0 %then -> abort l_opar_addr = 0; l_ipar_addr = 0 %return type sw(output done): ! transmitter %if l_o par_err # 0 %or l_opar_addr = 0 %start !! transmitter error p_len = -1; ! special flag to inc. 'l_dm' %else p_len = 0 %finish p_type = line output l_opar_addr = 0 %return type sw(input here): !! receiver interrupt %if l_i par_err # 0 %or l_ipar_addr = 0 %start f = -2; ! frame error %if l_i par_err&35 # 0 %then f = -3 %if l_i par_err = 4 %then f = -4 ! errors 4, 8 &16 -> frame ! 1, 2 &32 -> l_silo ! error 4 (crc) also incs l_crc fail %else f = l_i par_len-2; ! number of bytes trans %if f> 252 %start printstring("umc nasty:") octal(umc_addr); space; octal(cad); space; octal(f); newline %finish %finish p_type = line input p_address = l_in addr; ! pass block address back p_len = f l_ipar_addr = 0 %return type sw(line input): !! user call !! read request %if l_ipar_addr # 0 %then -> abort pad = p_address ! par = map abs(pad, p_len, rxreply) par = raddr(pad>>13) %if par = 0 %then -> abort par = par+(pad&k'17700')>>6; ! ensure actual block ext bits = (par&k'176000')>>10 l_i par_ext = ext bits cad = par << 6+pad&k'77' l_i par_addr = cad l_i par_len = p_len i = 1 ! umc_bit(0) = umc_bit(0)!!i; ! channel 1 (ie rx on line 0) umc word = umc word!!rx bit l_in addr = pad %return type sw(line output): !! output request %if l_opar_addr # 0 %then -> abort; ! compiler bug, if l_opar used oseg = p_address ! par = map abs(oseg, p_len, l_opar_addr) par = raddr(oseg>>13) %if par = 0 %then -> abort par = par+(oseg&k'17700')>>6; ! ensure actual block ext bits = (par&k'176000')>>10 l_o par_ext = ext bits l_o par_addr = par << 6+p_address&k'77' f = 0 l_o par_len = p_len umc word = umc word!!tx bit %return type sw(modem status): p_len = umc_bit(1) p_type = 0; ! for now %return abort: set prio(0) tell; printstring("umc fail");write(l_ipar_addr, 1); write(l_opar_addr, 1) write(p_type,1); newline %cycle; %repeat %end ! ! file 'fep_dqs12e' !************** !* dqs12e * !*da:04.jun.80* !************** ! %recordformat parf(%integer type, address, len) %routine dqs11e(%record (parf) %name p) %recordformat dqs11f(%integer mcsr, tcsr, rsr, rcr, twcr, tcar, %c rwcr, rcar) %ownrecord (dqs11f) %name dqs == 1; ! set up by prot on initialise %constinteger initialise = 0 %constinteger line input = 1 %constinteger line output = 2 %constinteger input here = 3 %constinteger output done = 4 %constinteger modem status = 5 %constinteger txgo = k'111' %constinteger rxgo = k'111' %switch typesw(initialise:modem status) %integer type, f, cad, oseg, i, ext bits %integer par, mid, pad dqs == l_handler address; ! from main prog -> type sw(p_type) type sw(initialise): dqs = 0; ! tidy it up first dqs_mcsr = k'40003'; ! don't transfer the crc dqs_rcr = k'10'; ! enable receiver dqs_tcsr = k'10'; ! enable transmitter l_ipar_addr = 0; l_opar_addr = 0 %return type sw(output done): ! transmitter %if dqs_tcsr < 0 %or l_opar_addr = 0 %start !! transmitter error tell; printstring("tx error ") p_len = 1 %else p_len = 0 %finish p_type = line output l_opar_addr = 0 %return type sw(input here): !! receiver interrupt %if dqs_rsr&k'34067' # 0 %or l_ipar_addr = 0 %start f = -2; ! frame error %if dqs_rsr&k'20' # 0 %then f = -3; ! l_silo full flt: dqs_rcr = 0; ! clear down dqs_rcr = k'10'; ! and up again %else %if dqs_rsr&k'1000' # 0 %then f = -1 %and -> flt ! wc overflow f = dqs_rcar-l_ipar_len-2 ! number of bytes trans %if dqs_rsr&k'074000' # 0 %then f = f-1 %if f<2 %or f> 252 %start tell; printstring("dqs nasty:") octal(dqs_rsr); space octal(dqs_rcar); space; octal(l_ipar_len); space; octal(f);newline %finish %finish p_type = line input p_address = l_ipar_addr; ! pass block address back p_len = f l_ipar_addr = 0 %return type sw(line input): !! user call !! read request %if l_ipar_addr # 0 %then -> abort pad = p_address ! par = map abs(pad, p_len, rxreply) par = raddr(pad>>13) %if par = 0 %then -> abort par = par+(pad&k'17700')>>6; ! ensure actual block ext bits = (par&k'176000')>>6 cad = par << 6+pad&k'77' dqs_rcar = cad dqs_rwcr =- (p_len >> 1) dqs_rcr = rxgo!ext bits l_ipar_addr = pad l_ipar_len = cad %return type sw(line output): !! output request %if l_opar_addr # 0 %then -> abort oseg = p_address ! par = map abs(oseg, p_len, l_opar_addr) par = raddr(oseg>>13) %if par = 0 %then -> abort par = par+(oseg&k'17700')>>6; ! ensure actual block ext bits = (par&k'176000')>>6 dqs_tcar = par << 6+p_address&k'77' f = 0 dqs_twcr =- ((p_len+1) >> 1) %if p_len&1 # 0 %start f = k'040000'; ! 8 in remaining bit field %finish dqs_tcsr = tx go!f!ext bits l_opar_addr = oseg %return type sw(modem status): p_len = dqs_mcsr p_type = 0; ! for now %return abort: set prio(1) tell; printstring("dqs fail ") %cycle; %repeat %end %endofprogram