! Special file system, implementing '$' pseudo-files. One process only, ! so no semaphores needed. %externalstring(47) copyright %alias "GDMR_(C)_F_SPECIAL" = %c "Copyright (C) 1987 George D.M. Ross" %option "-low-nonstandard-nocheck-nodiag-noline" !%option "-low-nonstandard" %constinteger buffer size = 4095 %constinteger buffers = 6 %include "Moose:Mouse.Inc" %include "GDMR_E:2Meg.Inc" %include "GDMR_H:FSysAcc.Inc" %include "GDMR_H:NFac.Inc" %include "GDMR_H:Dir.Inc"; ! For path fm %include "GDMR_H:DateTime.Inc" %include "GDMR_H:Auth.Inc" %include "INet:Stats.Inc" !! %include "GDMR_H:Dump.Inc" %externalpredicatespec FS lookup(%string(31) what, %integername result) %systemroutinespec phex(%integer i) %systemroutinespec phex2(%integer i) %systemstring(31)%fnspec itos(%integer i, j) %systemintegerfnspec free store %externalroutinespec FS insert(%string(31) name, %integer value) %ownrecord(mailbox fm) request mailbox = 0 %ownrecord(semaphore fm) request semaphore = 0 %ownrecord(semaphore fm) ether semaphore = 0 %ownrecord(mailbox fm) ether reply box = 0 %ownrecord(mailbox fm)%name ether box == nil %ownrecord(ether request fm) ether request = 0 %ownrecord(ether request fm)%name ether reply == nil !! %routine xprintstring(%string(255) s) !! %integer i, ch !! %return %if s = "" !! %for i = 1, 1, length(s) %cycle !! ch = charno(s, i) !! %if ' ' <= ch <= '~' %start !! print symbol(ch) !! %else !! print symbol('<') !! write(ch, 0) !! print symbol('>') !! %finish !! %repeat !! %end ! Buffers and buffer manipulation %recordformat buffer fm(%integer buffer ID, size, %bytename file, %bytearray x(0 : buffer size)) %ownrecord(buffer fm)%array buffer(0 : buffers) = 0(*) %owninteger buffer mask = 0 %integerfn claim buffer %record(buffer fm)%name b %integer i, m %for i = 0, 1, buffers %cycle m = 1 << i %if buffer mask & m = 0 %start !! printstring("Buffer "); write(i, 0) !! printstring(" claimed"); newline buffer mask = buffer mask ! m b == buffer(i) b_size = 0 b_buffer ID = i b_file == b_x(0) %result = i %finish %repeat !! printstring("No free special buffer"); newline %result = -1 %end %routine free buffer(%integer which) !! printstring("Buffer "); write(which, 0) !! printstring(" released"); newline buffer mask = buffer mask & (\ (1 << which)) %end %routine put byte(%integer what, %record(buffer fm)%name b) !! printstring("Put byte "); write(what, 0) !! %if ' ' <= what <= '~' %start !! printstring(" ("); print symbol(what) !! print symbol(')') !! %finish !! newline %return %if b_size >= buffer size b_x(b_size) = what b_size = b_size + 1 %end %routine put text(%string(255) what, %record(buffer fm)%name b) %integer i !! printstring("Put text """); xprintstring(what) !! print symbol('"'); newline %return %if what = "" %for i = 1, 1, length(what) %cycle %return %if b_size >= buffer size b_x(b_size) = charno(what, i) b_size = b_size + 1 %repeat %end %routine put integer(%integer n, f, %record(buffer fm)%name b) put text(itos(n, f), b) %end %routine put hex2(%integer n, %record(buffer fm)%name b) %integer x x = (n >> 4) & 15; %if x <= 9 %then x = x + '0' %else x = x - 10 + 'A' put byte(x, b) x = n & 15; %if x <= 9 %then x = x + '0' %else x = x - 10 + 'A' put byte(x, b) %end %routine put hex8(%integer n, %record(buffer fm)%name b) %integer x, i %for i = 1, 1, 8 %cycle x = (n >> 28) & 15 %if x <= 9 %then put byte(x + '0', b) %c %else put byte(x - 10 + 'A', b) n = n << 4 %repeat %end %routine put spaces(%integer n, %record(buffer fm)%name b) %while n > 0 %and b_size < buffer size %cycle b_x(b_size) = ' ' b_size = b_size + 1; n = n - 1 %repeat %end %routine put date and time(%integer dt stamp, %record(buffer fm)%name b) %string(15) d, t unpack date(dt stamp, d, t) put text(d, b); put byte(' ', b) put text(t, b) %end %routine copy data(%integer n, %bytename from, to) D0 = n - 1 L: *move.b (A0)+, (A1)+ *dbra D0, L %end ! Formats, constants and names (copied from other modules). ! From P_H2... %constinteger max Uno = 12 %constinteger max Xno = 24 %constinteger max ports = 63 %constinteger ether max = 536 %conststring(31) port table name = "P_H2_PORT_TABLE" %recordformat port fm(%integer remote address, remote port, local port, %integer tag, %integer open datestamp, transmit datestamp, %record(ether request fm) ether request, %bytename buffer) %conststring(31) Uno table name = "P_H2_UNO_TABLE" %recordformat Uno info fm(%integer port, tag, %integer opened datestamp, used datestamp, %string(31) username, domain, %integer user token, %string(127) login path, default path) %conststring(31) Xno table name = "P_H2_XNO_TABLE" %recordformat Xno info fm(%integer user token, %string(31) filename, %integer opened datestamp, used datestamp, %integer Uno, port, tag, mode, %integer file token1, file token2, flags, %integer size, blocks, next block) %constinteger Xno read access = 1 %constinteger Xno modify access = 2 ! From FSys... %constinteger partitions = 31 %constinteger open file limit = 48 %constinteger header cache size = 96 ! File header formats & constants. ! Access definitions (conventionally ID > 0 for user, < 0 for group) %recordformat header access fm(%integer ID, access) ! Extent definition %recordformat extent fm(%integer start, size) ! Header definition %constinteger non extent size = 8 + 2 + 2 + 12 + 8 + %c 12 + 12 + 16 + 4 + 2 + 2 %constinteger extent limit = (512 - non extent size) // 8 %constinteger access table size = extent limit; ! One grows up, other down %recordformat file header fm((%integer checksum, ID, %short header refcount, %short flags, %integer owner, owner access, supervisor, %integer world access, local access, %integer creator, static ID, audit ID, %integer created, modified, accessed, %string(15) creation name, %integer blocks used, %short bytes in last block, %short extent limit, ( %record(header access fm)%array %c access(1 : access table size) %c %or %record(extent fm)%array %c extent(1 : extent limit)) %c ) %or %integerarray x(1 : 128)) ! File header modes %constinteger no access = 0 { File is inaccessible %constinteger read access = 1 { File can be read %constinteger modify access = 2 { File can be modified %constinteger append access = 4 { File can be appended to %constinteger exchange access = 8 { File can be (extent) exchanged %constinteger link access = 16 { File can be (un)linked %constinteger control access = 32 { File attributes can be modified %constinteger deny access = 64 { Invert sense of access bits ! Partition tables %recordformat partition fm(%integer size, flags, index site, index size, bitmap, %bytename header allocation bitmap, %record(file header fm) index header) %constinteger partition valid = 1 %constinteger partition hazarded = 2 %constinteger partition structured = 4 ! Open file tables. There are two "structures" involved here. The simpler ! of the two is the open file table: this contains details of the user's ! (client's) use of the file; several concurrent users' entries are chained ! together for ease of access on a doubly-linked list. The header cache ! table contains the (shared) header details: in parallel for convenience of ! machine-code access is an array containing the header's ID. %recordformatspec header cache fm %recordformat open file table fm(%integer ID, %integer mode, %integer compatible, %integer last block read, %integer header cache slot, %record(header cache fm)%name fhce, %record(open file table fm)%name last, next) ! Should be something about access here too? %recordformat header cache fm(%integer stamp, refcount, status, dirty, %record(semaphore fm) semaphore, %record(open file table fm)%name use list, %record(file header fm) h) %constinteger slot allocated = 16_80000000 ! Common file system tables %recordformat common tables fm(%record(semaphore fm) initialisation semaphore, %record(semaphore fm) open file table semaphore, %record(partition fm)%array %c partition(1 : partitions), %record(open file table fm)%array %c open file table(1 : open file limit), %integer header cache stamp, %integerarray header ID(1 : header cache size), %record(header cache fm)%array %c header cache(1 : header cache size), %integer header cache hits, header cache misses) %conststring(31) fsys tables name = "FS__FSYS_TABLES" ! From Bitmap... %recordformat bitmap fm(%integer size, next, increment, %integername map, %record(semaphore fm) semaphore) ! Disc & cache statistics %externalroutinespec cache enquiry(%integername crh, crm, cwc, cwm, cpf) %include "GDMR_H:Disc.Inc" ! Translation cache %constinteger dir cache slot entries = 100 %constinteger dir cache slots = 64 %constinteger dir cache name limit = 23 %recordformat dir cache entry fm(%string(23) name, %integer ID) %recordformat dir cache slot fm(%integer n, stamp, %record(dir cache entry fm)%array e(1 : dir cache slot entries)) %recordformat dir cache fm(%record(semaphore fm) semaphore, %integer hits, misses, new dirs, new entries, %integerarray ID(1 : dir cache slots), %record(dir cache slot fm)%array s(1 : dir cache slots)) ! Special file creation routines %routine fill Unos(%record(buffer fm)%name b) %ownrecord(Uno info fm)%name Uno table == nil %record(Uno info fm)%name U %integer i, n %if Uno table == nil %start Uno table == record(i) %if FS lookup(Uno table name, i) %if Uno table == nil %start put text("** No Uno table available", b) put byte(NL, b) %return %finish %finish U == Uno table %for n = 0, 1, max Uno %cycle %if U_port # 0 %or n = 0 %start put integer(n, 2, b) put integer(U_port, 2, b); put spaces(2, b) put text(U_username, b) put spaces(12 - length(U_username), b) put byte(' ', b); put text(U_default path, b) put spaces(22 - length(U_default path), b) put byte(' ', b); put date and time(U_opened datestamp, b) put spaces(2, b); put date and time(U_used datestamp, b) put byte(NL, b) %finish U == U [1] %repeat %end %routine fill Xnos(%record(buffer fm)%name b) %ownrecord(Xno info fm)%name Xno table == nil %record(Xno info fm)%name X %integer i, n %if Xno table == nil %start Xno table == record(i) %if FS lookup(Xno table name, i) %if Xno table == nil %start put text("** No Xno table available", b) put byte(NL, b) %return %finish %finish X == Xno table %for n = 1, 1, max Xno %cycle %if X_Uno >= 0 %start put integer(n, 2, b) put integer(X_Uno, 2, b) put spaces(2, b); put text(X_filename, b) put spaces(31 - length(X_filename), b) put byte(' ', b); put date and time(X_opened datestamp, b) put spaces(2, b); put date and time(X_used datestamp, b) put spaces(2, b) put byte('R', b) %if X_mode & Xno read access # 0 put byte('M', b) %if X_mode & Xno modify access # 0 put byte(NL, b) %finish X == X [1] %repeat %end %routine fill ports(%record(buffer fm)%name b) %ownrecord(port fm)%name port table == nil %record(port fm)%name P %integer i, n %if port table == nil %start port table == record(i) %if FS lookup(port table name, i) %if port table == nil %start put text("** No port table available", b) put byte(NL, b) %return %finish %finish P == port table %for n = 1, 1, max ports %cycle %if P_remote address # 0 %start put integer(n, 2, b); put spaces(2, b) put hex8(P_tag, b); put spaces(2, b) put hex2(P_local port, b); put spaces(2, b) put hex2(P_remote address, b); put byte('.', b) put hex2(P_remote port, b); put spaces(2, b) put date and time(P_open datestamp, b); put spaces(2, b) put date and time(P_transmit datestamp, b) put byte(NL, b) %finish P == P [1] %repeat %end %recordformat kernel stats fm(%integerarray ints(0 : 7), %integerarray traps(0 : 15), %integer non triv signals, %integer triv signals, %integer non triv waits, %integer triv waits) %record(kernel stats fm)%map get kernel stats *clr.l D0 *move.l D0, A0 *trap #1 %result == record(A0) %end %routine fill kernel stats(%record(buffer fm)%name b) %conststring(15)%array trap names(0 : 15) = {0} " setSR ", {1} " orSR ", {2} " envQ ", {3} " trap3", {4} " trap4 ", {5} " trap5 ", {6} " signal ", {7} " wait", {8} " enQ ", {9} " deQ ", {A} " reQ ", {B} " unQ", {C} " inQ ", {D} " exQ ", {E} " trapE ", {F} " trapF " %record(kernel stats fm)%name ks %integer i ks == get kernel stats %if ks == nil %start put text("No kernel stats", b); put byte(NL, b) %return %finish %for i = 0, 1, 7 %cycle put integer(ks_ints(i), 10, b) put text(" int", b); put byte(i + '0', b) %if i & 3 = 3 %then put byte(NL, b) %c %else put text(" ", b) %repeat put byte(NL, b) %for i = 0, 1, 15 %cycle put integer(ks_traps(i), 10, b) put text(trap names(i), b) %if i & 3 = 3 %then put byte(NL, b) %repeat put byte(NL, b) put integer(ks_triv signals, 0, b) put text(" trivial signals, ", b) put integer(ks_non triv signals, 0, b) put text(" non-trivial signals, ", b) put integer(ks_non triv signals + ks_triv signals, 0, b) put text(" total", b); put byte(NL, b) put integer(ks_triv waits, 0, b) put text(" trivial waits, ", b) put integer(ks_non triv waits, 0, b) put text(" non-trivial waits, ", b) put integer(ks_non triv waits + ks_triv waits, 0, b) put text(" total", b); put byte(NL, b) %end %routine fill INet stats(%record(buffer fm)%name b) %ownrecord(INet statistics fm)%name s == nil %integer x %if s == nil %start %if FS lookup(INet statistics record name, x) %start !! printstring("Lookup: "); phex(x); newline s == record(x) %else put text("No INet statistics", b); put byte(NL, b) %return %finish %finish !! printstring("INet statistics record at "); phex(addr(s)); newline %if s_slow packets in > 0 %or s_slow packets out > 0 %start put integer(s_slow packets in, -8, b) put text(" slow in ", b) put integer(s_slow bytes in, -8, b) put text(" bytes in ", b) put integer(s_slow errors in, -8, b) put text(" errors in", b); put byte(NL, b) put integer(s_slow packets out, -8, b) put text(" pkts out ", b) put integer(s_slow bytes out, -8, b) put text(" bytes out ", b) put integer(s_slow errors out, -8, b) put text(" errors out", b); put byte(NL, b) put byte(NL, b) %finish %if s_fast packets in > 0 %or s_fast packets out > 0 %c %or s_ARP in > 0 %or s_ARP out > 0 %start put integer(s_fast packets in, -8, b) put text(" ether in ", b) put integer(s_fast bytes in, -8, b) put text(" bytes in ", b) put integer(s_fast errors in, -8, b) put text(" errors in", b); put byte(NL, b) put integer(s_fast packets out, -8, b) put text(" pkts out ", b) put integer(s_fast bytes out, -8, b) put text(" bytes out ", b) put integer(s_fast errors out, -8, b) put text(" errors out", b); put byte(NL, b) put integer(s_ARP in, -8, b) put text(" ARP in ", b) put integer(s_ARP errors in, -8, b) put text(" errors in ", b) put integer(s_ARP unknown, -8, b) put text(" unknown", b); put byte(NL, b) put integer(s_ARP for us, -8, b) put text(" for us ", b) put integer(s_ARP responses, -8, b) put text(" responses ", b) put integer(s_ARP for broadcast, -8, b) put text(" for broad", b); put byte(NL, b) put integer(s_ARP out, -8, b) put text(" ARP out ", b) put integer(s_ARP errors out, -8, b) put text(" errors out", b); put byte(NL, b) put byte(NL, b) %finish put integer(s_IP packets in, -8, b) put text(" IP in ", b) put integer(s_IP bytes in, -8, b) put text(" bytes in ", b) put integer(s_IP old broadcasts, -8, b) put text(" old broad ", b) put integer(s_IP new broadcasts, -8, b) put text(" new broad", b); put byte(NL, b) put integer(s_IP fragmented packets, -8, b) put text(" fragmented", b) put integer(s_IP fragmented bytes, -8, b) put text(" frag bytes", b) put integer(s_IP fragments dropped, -8, b) put text(" dropped ", b) put integer(s_IP fragmented bytes dropped, -8, b) put text(" bytes drpd", b); put byte(NL, b) put integer(s_IP dud lengths, -8, b) put text(" dud length", b) put integer(s_IP dud protocols, -8, b) put text(" dud prot ", b) put integer(s_IP other errors, -8, b) put text(" other errs", b); put byte(NL, b) put integer(s_IP packets routed, -8, b) put text(" pckts rtd ", b) put integer(s_IP bytes routed, -8, b) put text(" bytes rtd ", b) put integer(s_IP packets out, -8, b) put text(" pckts out ", b) put integer(s_IP bytes out, -8, b) put text(" bytes out", b); put byte(NL, b) put byte(NL, b) put integer(s_ICMP in, -8, b) put text(" ICMP in ", b) put integer(s_ICMP errors in, -8, b) put text(" errors in ", b) put integer(s_ICMP broadcasts, -8, b) put text(" broadcasts", b); put byte(NL, b) put integer(s_ICMP out, -8, b) put text(" ICMP out ", b) put integer(s_ICMP errors out, -8, b) put text(" errors out", b); put byte(NL, b) put byte(NL, b) put integer(s_TCP packets in, -8, b) put text(" TCP in ", b) put integer(s_TCP bytes in, -8, b) put text(" bytes in ", b) put integer(s_TCP packets out, -8, b) put text(" pckts out ", b) put integer(s_TCP bytes out, -8, b) put text(" bytes out", b); put byte(NL, b) put integer(s_TCP bogus addresses, -8, b) put text(" bogus adrs", b) put integer(s_TCP checksum errors, -8, b) put text(" chck errs ", b) put integer(s_TCP for closed, -8, b) put text(" for closed", b) put integer(s_TCP resets received, -8, b) put text(" resets", b); put byte(NL, b) put integer(s_TCP junk received, -8, b) put text(" junk ", b) put integer(s_TCP SYNs received, -8, b) put text(" SYNs ", b) put integer(s_TCP FINs received, -8, b) put text(" FINs", b); put byte(NL, b) put integer(s_TCP good ACKs received, -8, b) put text(" good ACKs ", b) put integer(s_TCP old ACKs received, -8, b) put text(" old ACKs ", b) put integer(s_TCP dud ACKs received, -8, b) put text(" dud ACKs ", b) put integer(s_TCP window updates, -8, b) put text(" window ups", b); put byte(NL, b) put integer(s_TCP connections established, -8, b) put text(" estblished", b) put integer(s_TCP connections reset, -8, b) put text(" reset ", b) put integer(s_TCP connections closed, -8, b) put text(" closed", b); put byte(NL, b) put integer(s_TCP acceptable segments, -8, b) put text(" acceptable", b) put integer(s_TCP unacceptable segments, -8, b) put text(" unaccptble", b) put integer(s_TCP ahead segments, -8, b) put text(" ahead ", b) put integer(s_TCP duplicate bytes, -8, b) put text(" duplicate", b); put byte(NL, b) put integer(s_TCP data bytes received, -8, b) put text(" data bytes", b) put integer(s_TCP data bytes sent, -8, b) put text(" data sent ", b) put integer(s_TCP retransmits, -8, b) put text(" reTXs ", b) put integer(s_TCP retransmit timeouts, -8, b) put text(" reTX tmos", b); put byte(NL, b) put byte(NL, b) put integer(s_UDP packets in, -8, b) put text(" UDP in ", b) put integer(s_UDP bytes in, -8, b) put text(" bytes in", b); put byte(NL, b) put integer(s_UDP checksum errors, -8, b) put text(" check errs", b) put integer(s_UDP no checksums, -8, b) put text(" no check ", b) put integer(s_UDP bogus checksums, -8, b) put text(" bogus chck", b) put integer(s_UDP other errors, -8, b) put text(" other errs", b); put byte(NL, b) put integer(s_UDP packets out, -8, b) put text(" pckts out ", b) put integer(s_UDP bytes out, -8, b) put text(" bytes out", b); put byte(NL, b) put byte(NL, b) put integer(s_RIP packets in, -8, b) put text(" RIP in ", b) put integer(s_RIP dropped, -8, b) put text(" dropped ", b) put integer(s_RIP updated, -8, b) put text(" updated ", b) put integer(s_RIP packets out, -8, b) put text(" RIP out", b); put byte(NL, b) %end %routine fill 2meg stats(%record(buffer fm)%name b) %record(ether stats fm) stats = 0 %integer i %if ether box == nil %start %if FS lookup(ether mailbox name, i) %start ether box == record(i) %else put text("** No ether mailbox?", b); put byte(NL, b) %return %finish setup semaphore(ether semaphore) setup mailbox(ether reply box, ether semaphore) setup message(ether request, size of(ether request)) %finish ether request_code = ether stats ether request_stats == stats send message(ether request, ether box, ether reply box) ether reply == receive message(ether reply box) %if ether reply_status < 0 %start put text("""Ether stats"" failed: ", b) put text(ether errors(ether reply_status), b) put byte(NL, b) %return %finish put text("Station address is ", b) put hex2(stats_station address, b) put byte(NL, b) put integer(stats_buffer low water, 9, b) put text(" buffer low water", b) put byte(NL, b) put integer(stats_unrecognised control, 9, b) put text(" unrecognised control", b) put byte(NL, b) put integer(stats_inbound packets, 9, b) put text(" inbound packets", b) put byte(NL, b) put integer(stats_inbound bytes, 9, b) put text(" inbound bytes", b) put byte(NL, b) put integer(stats_outbound packets, 9, b) put text(" outbound packets", b) put byte(NL, b) put integer(stats_outbound bytes, 9, b) put text(" outbound bytes", b) put byte(NL, b) put integer(stats_dud destinations, 9, b) put text(" dud destinations", b) put byte(NL, b) put integer(stats_dud types, 9, b) put text(" dud types", b) put byte(NL, b) put integer(stats_old inbound packets, 9, b) put text(" old inbound packets", b) put byte(NL, b) put integer(stats_old outbound packets, 9, b) put text(" old outbound packets", b) put byte(NL, b) put integer(stats_old inbound no takers, 9, b) put text(" old inbound no takers", b) put byte(NL, b) put integer(stats_old retransmits, 9, b) put text(" old retransmits", b) put byte(NL, b) put integer(stats_old ACK timeouts, 9, b) put text(" old ACK timeouts", b) put byte(NL, b) put integer(stats_old user timeouts, 9, b) put text(" old user timeouts", b) put byte(NL, b) put integer(stats_old defines, 9, b) put text(" old defines", b) put byte(NL, b) put integer(stats_old redefines, 9, b) put text(" old redefines", b) put byte(NL, b) put integer(stats_old undefines, 9, b) put text(" old undefines", b) put byte(NL, b) put integer(stats_old reads, 9, b) put text(" old reads", b) put byte(NL, b) put integer(stats_old writes, 9, b) put text(" old writes", b) put byte(NL, b) %end %routine put ether address(%bytename a, %record(buffer fm)%name b) %integer i %for i = 0, 1, 5 %cycle put byte('-', b) %unless i = 0 put hex2(a, b); a == a [1] %repeat %end %routine fill lance stats(%record(buffer fm)%name b) %recordformat ether request fm(%record(message fm) system part, %record(ether request fm)%name next, %integer code, slot, tag, status, %integer type, %bytename buffer, %integer bytes) %recordformat ether statistics fm(%bytearray address(0 : 5), %integer packets in, %integer bytes in, %integer packets out, %integer bytes out, %integer no takers tally, %integer babl tally, %integer miss tally, %integer merr tally, %integer fram tally, %integer oflo tally, %integer CRC tally, %integer buff tally, %integer more tally, %integer one tally, %integer def tally, %integer uflo tally, %integer lcol tally, %integer lcar tally, %integer rtry tally) %conststring(31) ether mailbox name = "ETHER_REQUESTS" %constinteger ether statistics = 6 %record(ether statistics fm) stats %record(semaphore fm) sem %record(mailbox fm) box %ownrecord(mailbox fm)%name ether box == nil %record(ether request fm) req %record(ether request fm)%name rep %integer x %if ether box == nil %start %if FS lookup(ether mailbox name, x) %start ether box == record(x) %else put text("No LANCE", b); put byte(NL, b) %return %finish %finish setup semaphore(sem) setup mailbox(box, sem) setup message(req, size of(req)) req_code = ether statistics req_buffer == byteinteger(addr(stats)) send message(req, ether box, box) rep == receive message(box) %if rep ## req %or req_status # ether success %start printstring("Failed: "); write(req_status, 0); newline %stop %finish put text("Station address: ", b); put ether address(stats_address(0), b) put byte(NL, b); put byte(NL, b) put integer(stats_packets in, 8, b); put text(" packets in ", b) put integer(stats_bytes in, 10, b); put text(" bytes in ", b) put integer(stats_no takers tally, 8, b); put text(" no takers", b) put byte(NL, b) put integer(stats_packets out, 8, b); put text(" packets out", b) put integer(stats_bytes out, 10, b); put text(" bytes out", b) put byte(NL, b); put byte(NL, b) put integer(stats_babl tally, 8, b); put text(" babl", b) put integer(stats_miss tally, 8, b); put text(" miss", b) put integer(stats_merr tally, 8, b); put text(" merr", b) put integer(stats_buff tally, 8, b); put text(" buff", b) put byte(NL, b) put integer(stats_fram tally, 8, b); put text(" fram", b) put integer(stats_oflo tally, 8, b); put text(" oflo", b) put integer(stats_CRC tally, 8, b); put text(" CRC ", b) put byte(NL, b) put integer(stats_more tally, 8, b); put text(" more", b) put integer(stats_one tally, 8, b); put text(" one ", b) put integer(stats_def tally, 8, b); put text(" def ", b) put byte(NL, b) put integer(stats_uflo tally, 8, b); put text(" uflo", b) put integer(stats_lcol tally, 8, b); put text(" lcol", b) put integer(stats_lcar tally, 8, b); put text(" lcar", b) put integer(stats_rtry tally, 8, b); put text(" rtry", b) put byte(NL, b) %end %routine fill disc stats(%record(buffer fm)%name b) %integer crh, crm, cwc, cwm, cpf, dr, dw, dhw, rate, x, y cache enquiry(crh, crm, cwc, cwm, cpf) rate = 10000 * crh // (crh + crm) x = rate // 100; y = rate - 100 * x put integer(crh, 0, b); put text(" read hits, ", b) put integer(crm, 0, b); put text(" read misses (", b) put integer(x, 0, b); put byte('.', b) put integer(y, 0, b); put text("% hits), ", b) put integer(cpf, 0, b); put text(" prefetches", b) put byte(NL, b) put integer(cwc, 0, b); put text(" write copies, ", b) put integer(cwm, 0, b); put text(" write misses", b) put byte(NL, b) disc stats(dr, dw, dhw) put integer(dr, 0, b); put text(" disc reads, ", b) put integer(dw, 0, b); put text(" disc writes, ", b) put integer(dhw, 0, b); put text(" disc high water", b) put byte(NL, b) %end %constinteger trace buffer size = 8 + 128 * (16 + 48) %conststring(31) trace buffer name = "P_H2_TRACE_BUFFER" %routine map trace buffer(%record(buffer fm)%name b) %integer i %if FS lookup(trace buffer name, i) %start b_file == byteinteger(i) b_size = trace buffer size %finish ! Else, size will be zero %end %record(common tables fm)%map fsys tables %ownrecord(common tables fm)%name tables == nil %integer i %if tables == nil %start tables == record(i) %if FS lookup(fsys tables name, i) %finish !! printstring("FSys tables at "); phex(addr(tables)); newline %result == tables %end %routine map bitmap(%integer which, %record(buffer fm)%name b) %record(common tables fm)%name tables %record(bitmap fm)%name bitmap %record(partition fm)%name p tables == fsys tables %return %if tables == nil !! printstring("Map bitmap "); print symbol(which); newline %if '0' <= which <= '9' %start which = which - '0' %else %if 'A' <= which <= 'Z' which = which - 'A' + 10 %else %if 'a' <= which <= 'z' which = which - 'a' + 10 %finish %return %unless 0 < which <= partitions p == tables_partition(which) !! printstring("Partition table at "); phex(addr(p)) !! printstring(", flags "); phex(p_flags); newline %return %if p_flags & partition valid = 0 %c %or p_flags & partition structured = 0 bitmap == record(p_bitmap) b_file == byteinteger(addr(bitmap_map)) b_size = bitmap_size // 8 %end %routine fill header cache(%record(buffer fm)%name b) %record(common tables fm)%name tables %record(header cache fm)%name h %integer i, x tables == fsys tables %return %if tables == nil i = tables_header cache hits + tables_header cache misses put integer(tables_header cache hits, 0, b) put text(" hits, ", b) put integer(tables_header cache misses, 0, b) put text(" misses (hit rate ", b) %if i = 0 %start put text("?? ", b) %else put integer(100 * tables_header cache hits // i, 0, b) %finish put text("%)", b) put byte(NL, b) x = 0 %for i = 1, 1, header cache size %cycle h == tables_header cache(i) %if h_stamp > 0 %start put integer(i, 3, b); put byte(' ', b) put hex8(tables_header ID(i), b); put byte(' ', b) put hex8(h_stamp, b); put integer(h_refcount, 2, b) %if h_status # 0 %start put integer(h_status, 4, b) %else %if h_dirty # 0 put text(" D ", b) %else put text(" ", b) %finish x = \x %if x = 0 %then put byte(NL, b) %c %else put text(" ", b) %finish %repeat put byte(NL, b) %if x # 0 %end %routine fill open files(%record(buffer fm)%name b) %record(common tables fm)%name tables %record(open file table fm)%name oft %integer i tables == fsys tables %return %if tables == nil %for i = 1, 1, open file limit %cycle oft == tables_open file table(i) %if oft_mode # 0 %start put hex8(oft_ID, b) put integer(oft_header cache slot, 3, b) put spaces(3, b) %if oft_mode = 0 %start put text("*none*", b) %else put byte('R', b) %if oft_mode & read access # 0 put byte('M', b) %if oft_mode & modify access # 0 put byte('A', b) %if oft_mode & append access # 0 put byte('X', b) %if oft_mode & exchange access # 0 put byte('L', b) %if oft_mode & link access # 0 put byte('C', b) %if oft_mode & control access # 0 %finish put spaces(3, b) %if oft_compatible = 0 %start put text("*none*", b) %else put byte('R', b) %if oft_compatible & read access # 0 put byte('M', b) %if oft_compatible & modify access # 0 put byte('A', b) %if oft_compatible & append access # 0 put byte('X', b) %if oft_compatible & exchange access # 0 put byte('L', b) %if oft_compatible & link access # 0 put byte('C', b) %if oft_compatible & control access # 0 %finish put byte(NL, b) %finish %repeat %end %routine fill directory cache(%record(buffer fm)%name b) %ownrecord(dir cache fm)%name c == nil %integer x %if c == nil %start %if FS lookup("FS__DIRECTORY_CACHE", x) %start c == record(x) %else put text("No directory cache", b); put byte(NL, b) %return %finish %finish put integer(c_hits, 0, b); put text(" hits, ", b) put integer(c_misses, 0, b); put text(" misses (", b) x = c_hits + c_misses; x = 1 %if x = 0 put integer(100 * c_hits // x, 0, b) put text("% hits), ", b) put integer(c_new dirs, 0, b); put text(" new directory slots, ", b) put integer(c_new entries, 0, b); put text(" new file entries", b) put byte(NL, b) %end ! Action routines for each of the meaningful request codes (open, read, close) %routine do open file(%record(fs message fm)%name m) %record(buffer fm)%name b %record(path fm)%name p %string(255) name, s %integer assigned %if m_mode # read file mode %start !! printstring("Trying to write to a special file"); newline m_components translated = 0 m_error code = -1; m_status = -1 m_textual response = "Invalid operation on read-only special file" %return %finish !! p == m_filename !! printstring("Open special file: name at "); phex(addr(p)) !! %if p ## nil %start !! printstring(", name is """); printstring(p_key) !! print symbol('"') !! %finish !! newline assigned = claim buffer %if assigned < 0 %start m_components translated = 0 m_error code = -1; m_status = -1 m_textual response = "No free special buffer" %return %finish b == buffer(assigned) p == m_filename %if p == nil %or p_key = "" %start ! Null name specified, assume we want the "directory" listing !! printstring("Generating ""directory"" listing"); newline put text("2Meg_Stats", b); put byte(NL, b) put text("Bitmap.X", b); put byte(NL, b) put text("Directory_Cache", b); put byte(NL, b) put text("Disc_Stats", b); put byte(NL, b) put text("Header_Cache", b); put byte(NL, b) put text("INet_Stats", b); put byte(NL, b) put text("Kernel_Stats", b); put byte(NL, b) put text("LANCE_Stats", b); put byte(NL, b) put text("Open_Files", b); put byte(NL, b) put text("Ports", b); put byte(NL, b) put text("Trace_Buffer", b); put byte(NL, b) put text("UNos", b); put byte(NL, b) put text("XNos", b); put byte(NL, b) -> success response %finish name = p_key; to upper(name) !! printstring("Do open "); printstring(name); newline %if name = "UNOS" %start fill Unos(b) %else %if name = "XNOS" fill Xnos(b) %else %if name = "PORTS" fill ports(b) %else %if name = "HEADER_CACHE" fill header cache(b) %else %if name = "OPEN_FILES" fill open files(b) %else %if name = "DISC_STATS" fill disc stats(b) %else %if name = "DIRECTORY_CACHE" fill directory cache(b) %else %if name = "KERNEL_STATS" fill kernel stats(b) %else %if name = "INET_STATS" fill INet stats(b) %else %if name = "2MEG_STATS" fill 2meg stats(b) %else %if name = "LANCE_STATS" fill lance stats(b) %else %if name = "TRACE_BUFFER" map trace buffer(b) %else %if name -> ("BITMAP.") . s %and s # "" map bitmap(charno(s, 1), b) %else ! Come in here if the name wasn't recognised free buffer(assigned) m_components translated = 0 m_error code = -1; m_status = -1 m_textual response = "Unrecognised special file" %return %finish ! Drop through here on success: return token, size and status to caller success response: m_file token = addr(b); m_byte count = b_size m_response flags = 0 %if p == nil %then m_components translated = 0 %c %else m_components translated = 1 m_followup mailbox == request mailbox m_error code = 0; m_status = 0 !! printstring("Common success: token "); phex(m_file token) !! printstring(", size "); write(m_byte count, 0); newline %end %routine do close file(%record(fs message fm)%name m) %record(buffer fm)%name b !! printstring("Do close (special) file"); newline b == record(m_file token) free buffer(b_buffer ID) m_error code = 0; m_status = 0 %end %routine do read data(%record(fs message fm)%name m) %record(buffer fm)%name b %integer p, n !! printstring("Do read (special) data: offset "); write(m_byte offset, 0) !! printstring(", bytes "); write(m_byte count, 0); newline b == record(m_file token) p = m_byte offset %if 0 <= p <= b_size %start n = m_byte count n = b_size - p %if p + n > b_size copy data(n, b_file [p], m_data buffer) m_byte count = n m_error code = 0; m_status = 0 !! dump(m_byte count, m_data buffer) %else m_error code = -1; m_status = -1 m_textual response = "End of (special) file" %finish %end %begin %record(fs message fm)%name m %ownrecord(semaphore fm) disaster = 0 %record(poa fm)%name P %switch standard(-1 : last standard request) %integer i !%on 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 %start ! ! Last-chance disaster-trap ! P == POA ! printstring("F_Spcl: unexpected event "); write(P_event, 0) ! space; write(P_event sub, 0); space; phex(P_event extra) ! space; printstring(P_event message) ! printstring(" at or about PC "); phex(P_event PC) ! newline ! %for i = 0, 1, 15 %cycle ! phex(P_event r(i)); space ! newline %if i & 7 = 7 ! %repeat ! semaphore wait(disaster) !%finish open input(3, ":N"); select input(3) open output(3, ":T"); select output(3) setup semaphore(disaster) setup semaphore(request semaphore) setup mailbox(request mailbox, request semaphore) FS insert(special file system mailbox, addr(request mailbox)) {} printstring("F_Special: "); write(free store, 0) {} printstring(" free"); newline %cycle m == receive message(request mailbox) %if m_request & filesystem mask = 0 %start i = m_request & request mask -> standard(i) %if 0 <= i <= last standard request %else ! A request code for someone else %if m_request & interpret filename # 0 %start m_error code = -1; m_status = -1 m_textual response = "(Special) file not found"; ! By definition %else m_error code = -1; m_status = -1 m_textual response = "Wrong filesystem for request" %finish -> send reply %finish dud request: m_error code= -1; m_status = -1 m_textual response = "Unknown request code" -> send reply standard(open file request & request mask): do open file(m) -> send reply standard(close file request & request mask): do close file(m) -> send reply standard(read data request & request mask): do read data(m) -> send reply standard(*): m_error code= -1; m_status = -1 m_textual response = "Unimplemented request code" send reply: send message(m, m_system header_reply, nil) %repeat %end %of %program