!***************************************** !* Amdahl-FEP: Info Responder * !* File : ERCM09:x25gen.NEWINFO * !***************************************** %control x'4001' %include "ercm09:b_deimosspecs" %begin %conststring (*) version = "info...1d" #datestring #timestring !*************************** !* Configuration constants * !*************************** ! %constinteger info stream = 1 {output stream for info updates} !* Services provided by INFO !***************************** ! %constinteger LOG MSG = 1 {send log msg to info} !***************** !* Stream states * !***************** ! %constinteger input = 0, output = 1 %constinteger unused = 0, disconnecting = 1, connecting = 2, connected = 3, suspending = 4, aborting = 5, enabling = 7, enabled = 8 !************** ! Host states * !************** ! %constinteger up = 0, down = 1 !************************************************************** !* buffer manager calls (from and to) * !************************************************************** ! %constinteger BUFFER MANAGER = 17 ! %constinteger request buffer = 0, release buffer = 1, get buff range = 2 %constbyte SMALL = 1, SMALL SIZE = ( 1*64)-12, BIG = 0, BIG SIZE = ( 5*64)-12, GIANT = 2, GIANT SIZE = (65*64)-12 %constbytearray FRIG TYPE(BIG:GIANT) = x'00',x'80',x'81' ! ! the above array is used to map from the type used when a buffer is ! requested to the type with which the resulting buffer is stamped. ! at some state it is hoped that buffer manager will be modified to ! use the same set of type codes for both purposes. ! !************************************************************** !* calls to and from host link handler * !************************************************************** ! %constinteger LINK HANDLER = 18 ! %constinteger high level control = 0, { calls } low level control = 1, claim stream = 2, request transfer = 3, repeat transfer = 4, discard transfer = 5 %constinteger interf addr = 0, { responses } input done = 1, output done = 2, message = 3, host up = 4, host down = 5 !************************************* ! ygate requests and responses !************************************* ! %constinteger GATE SERVER = 24 ! %include "ercm09:inc_xgtfns" !*************************** !* various service numbers * !*************************** ! %constinteger t3 ser = 21 !****************** !* Record formats * !****************** %recordformat pf %c ( %c %byte server, %c reply, %c ( %c %byte fn, %c qualifier, %c %integer buffno, %c ( %c %integer stream %c %or %c %byte type, reason %c %or %c %byte gref, tref %c ) %c %or %c %integer a, b, c %c %or %c %byte a1, a2, b1, b2, c1, c2 %c ) %c ) %recordformat qf %c ( %c %record (qf) %name link, { chain to next item in q } %c %byte count, { count of items in queue } %c max { max no of items in queue } %c ) %recordformat parmf %c ( %c %integer a, b %c %or %c %byte a1, a2, b1, b2 %c ) %recordformat cntlf %c ( %c %integer stream, %c subid, %c %record (parmf) %array p(2:6) %c ) %recordformat dataf %c ( %c %integer mins, %c secs, %c spare1, %c spare2, {small buffer vsn} %c %bytearray byte(0:255) %c ) %recordformat msgf %c ( %c %record (msgf) %name link, %c %byte len, %c type, %c ( %c %record (cntlf) cntl %c %or %c %record (dataf) data %c %or %c %bytearray param(0:255) %c ) %c ) %recordformat strmf %c ( %c %integer number, %c state, %c mode, %c busy, %c length, %c cursor, %c limit, %c trigger, %c %record (qf) queue %c ) %recordformat holdf %c ( %c %record (holdf) %name link, %c %integer buffno %c ) %recordformat infof %c ( %c %byte tsbyte, %c flag, %c %bytearray name(0:12), %c %byte service level, %c %bytearray users(0:1), %c total(0:1), %c %byte load, %c %bytearray reserved(0:43), %c %bytearray alert text(0:62) %c ) %recordformat datef %c ( %c %byte len, %c day, mon, year, %c hour, min, sec %c %or %c %string (6) s %c ) %constinteger UNDEFINED = 0, NO USER SERVICE = 1, NORMAL SERVICE = 2, NO SERVICE = 10, UNASSIGNED = 11 %conststring(20)%array service text(undefined:unassigned) = %c "??", "No user service", "Normal service", "System closing", "System full", "Resources scarce", "Reduced h/w config", "Software development", "Hardware maintenance", "Hardware fault", "No service", "??" %constinteger IDLE = 0, WAITING = 1, TRYING = 2, WORKING = 3, CLOSING = 4 %conststring(7)%array statename(IDLE:CLOSING) = %c "IDLE", "WAITING", "TRYING", "WORKING", "CLOSING" !************************** !* Routine specifications * !************************** ! %externalstring (15) %fnspec itos(%integer no, width) %include "routines" !********************* !* Data declarations * !********************* ! %constinteger seg4stacktop = 10 %integer seg4level = 0 %integerarray seg4stack(0:seg4stacktop) %record (msgf) %name seg4 %owninteger i, mon = 0 %ownrecord (pf) p %ownrecord (strmf) s %ownrecord (infof) info %owninteger host state = down %owninteger clock = 0, interval = 60, period = 10, tickrate = 50, lograte = 30, lastmin = 0 %integer uptime = 0, { uptime in hours } upsecs = 0 { " " secs } %record (datef) date %string (31) dates %owninteger log state = IDLE %ownrecord (qf) log queue = 0 %owninteger log line = 0, log lines = 0 %constinteger MAX LINES = 4 %ownstring (63) %array log addr(1:MAX LINES) %ownintegerarray log fail(1:MAX LINES) %string (127) temps %owninteger buff base, buff limit %ownrecord (qf) free hold %constinteger HOLD SIZE = 10 %ownrecord (holdf) %array hba(1:HOLD SIZE) !********************************************** !* main routine * !********************************************** use tt(t3 ser) i = map virt(buffer manager, 5, 4) i = map virt(buffer manager, 6, 5) print version free hold = 0; push(free hold, hba(i)) %for i = 1, 1, HOLD SIZE alarm(period*tickrate) {p_server = 0} {poff(p)} {lograte = p_a1} date = 0 %for i = 1, 1, MAX LINES %cycle log addr(i) = "" log fail(i) = 0 %repeat info = 0 info_service level = NORMAL SERVICE s = 0 s_number = INFO STREAM host state = DOWN linkin(Link Handler); {NB: NASTY, HORRIBLE !!} register name("INFO") queue log msg("Snoop Reloaded") %cycle p_server = 0 poff(p); log request(p) %if mon # 0 %if p_reply = gate server %start from gate(p) %elseif p_reply # 0 from user(p) %else clock interrupt alarm(period*tickrate) %finish %if int # 0 %start console interrupt(int) int = 0 %finish %repeat !*************************** !* Routines to do the work * !*************************** %routine print version !===================== printstring(version) space; printstring(datestring) space; printstring(timestring) newline %end %routine print info(%record (infof) %name info) !============================================== %routine printtext(%bytearrayname b) !------------------------------- %integer i = 0 %while b(i) # 0 %cycle printsymbol(b(i)) i = i+1 %repeat %end printstring("Info: "); printtext (info_name) printstring(", " ); printstring(service text(info_service level)) printstring(". " ); printtext (info_alert text) newline printstring(" users ="); write(swab(integer(addr(info_users))),0); newline printstring(" total ="); write(swab(integer(addr(info_total))),0); newline printstring(" load ="); write(info_load ,0); newline %end %routine print log details !========================= %record (msgf) %name msg %integer i, line make date string printstring("Info: log state = ".statename(log state)); newline printstring(" date&time = ".dates); newline printstring(" uptime ="); write(uptime, 0); newline printstring(" msg queue ="); write(log queue_count, 0); newline %if log queue_count > 0 %start %for i = 1, 1, log queue_count %cycle write(i,14); spaces(3) msg == pop(log queue); push(log queue, msg) printstring(string(addr(msg_data_byte(-1)))) newline %repeat %finish printstring(" addresses ="); write(log lines, 0); newline %if log lines > 0 %start %for line = 1, 1, log lines %cycle write(line,14) %if line = log line %then printstring(" * ") %else spaces(3) printstring(log addr(line)) newline %repeat %finish %end %routine crash(%integer reason) !============================== %integer i %cycle i = 1, 1, 10 printstring("**** info fault ") write(reason,1) printstring(", take dump ****") newline %repeat *=k'104001' { emt wait } %end %routine push(%record (qf) %name q,new) !====================================== q_count = q_count + 1 q_max = q_count %if q_count > q_max %if q_link == null %start q_link == new new_link == new %else new_link == q_link_link q_link_link == new q_link == new %finish %end %record (qf) %map pop(%record (qf) %name q) !========================================== %record (qf) %name old %if q_link == null %then old == null %elsestart %if q_link_link == q_link %start ;!One element only on Q old == q_link q_link == null %else old == q_link_link q_link_link == old_link %finish old_link == null q_count = q_count - 1 %finish %result == old %end %routine push seg4 %end %routine pop seg4 %end %record (msgf) %map get buffer(%integer type) !============================================= %record (pf) p %record (msgf) %name msg p = 0 p_server = buffer manager p_reply = own id p_fn = request buffer p_type = type pon(p); logrequest(p) %if mon # 0 integer(addr(p)) = swab(integer(addr(p))) poff(p); logrequest(p) %if mon # 0 msg == record(p_buffno) msg_len = 0 %result == msg %end %record (msgf) %map claim buffer(%integer buffno) !================================================ %record (msgf) %name msg msg == record(buffno) %result == msg %end %routine free buffer(%record (msgf) %name msg) !============================================= %record (pf) p %return %if msg == null p_server = buffer manager p_reply = own id p_fn = release buffer p_buffno = addr(msg) pon(p); logrequest(p) %if mon # 0 %end %routine hexb(%byteinteger i) !============================ %string (16) hex %string (16) %name hexref hex = "0123456789ABCDEF" hexref == hex printsymbol(charno(hexref,1+(i >> 4)&x'F')) printsymbol(charno(hexref,1+(i )&x'F')) %end %routine hexw(%integer i) !============================ hexb((i>>8)&x'FF') hexb((i )&x'FF') %end %routine logrequest(%record (pf) %name p) !======================================== %if p_reply = own id %start printstring("Pon : ") %else printstring("Poff: ") %finish write(p_server,1) write(p_reply,1) write(p_fn,1) write(p_qualifier,1) printsymbol(' ');hexw (p_buffno) write(p_tref,1) write(p_gref,1) newline %end %record (infof) %map info map(%integer address) !============================================== %result == record(address) %end %routine from user(%record (pf) %name p) !========---------====================== %record (msgf ) %name msg %record (holdf) %name tail msg == claim buffer(p_buffno) %if p_fn = LOGMSG %and msg ## null %start msg_data_secs = 0 msg_data_mins = 0 %if msg_len >= SMALL SIZE %start msg_len = SMALL SIZE - 1 msg_data_byte(msg_len-1) = '?' %finish push(logqueue, msg); msg == null %if log state = IDLE %and log lines > 0 %start start line(1) new log state(TRYING) %finish %finish free buffer(msg) %if msg ## null %end %routine to host(%integer fn, %record (strmf) %name stream, %record (msgf) %name msg) !=================================================================================== printstring("to host called ") %end %routine from host(%record (pf) %name p) !======================================= printstring("from host called ") %end %routine to gate(%integer fn, qual, %byte tref, gref, %record (msgf) %name msg) !=============================================================================== %record (pf) p p = 0 p_server = gate server p_reply = own id p_fn = fn p_qualifier = qual p_tref = tref p_gref = gref p_buffno = addr(msg) %if msg ## null pon(p); logrequest(p) %if mon # 0 %end %routine from gate(%record (pf) p) !================================= %record (msgf) %name msg %switch fn(connect: control data) %routine reset failures !---------------------- %integername failures failures == log fail(log line) failures = 0 %end %integerfn count failures !------------------------ %integername failures failures == log fail(log line) failures = failures+1 %result = failures %end {new} %routine send invitation to clear {new} !-------------------------------- {new} %record (msgf) %name msg {new} push seg4 {new} msg == get buffer(SMALL) {new} msg_data_byte(0) = x'80' {TS29 control message} {new} msg_data_byte(1) = x'01' {invitation to clear } {new} msg_len = 2 {new} to gate(data, 1, p_tref, p_gref, msg) {new} pop seg4 {new} %end {new} %routine send log queue head !-------------------- %integer space %record (msgf) %name msg push seg4 msg == pop(log queue) move(msg_len, addr(msg_data_byte(0)), addr(msg_data_byte(1))) msg_data_byte(0) = 0 {TS Header Byte} msg_len = msg_len + 1 temps = "" temps = ", q'd".itos(msg_data_mins,0)." mins" %if msg_data_mins # 0 space = SMALL SIZE - msg_len length(temps) = space %if space < length(temps) move(length(temps), addr(temps)+1, addr(msg_data_byte(msg_len))) msg_len = msg_len + length(temps) %if msg_len = SMALL SIZE %start msg_len = msg_len - 1 msg_data_byte(msg_len-1) = '?' %finish msg_data_byte(msg_len ) = 0 msg_len = msg_len + 1 to gate(data, 1, p_tref, p_gref, msg) pop seg4 %end msg == claim buffer(p_buffno) -> fn(p_fn) fn(connect): %if register addr(getstring(msg, 2)) %start %if IDLE <= log state <= WAITING %and log queue_count > 0 %start start line(log lines) new log state(TRYING) %finish %finish temps = getstring(msg, 2) %if temps -> temps.(".POLLER") %c %and length(getstring(msg, 4)) = 6 %start %if length(date_s) = 0 %start date_s = getstring(msg, 4) print date string %else date_s = getstring(msg, 4) maybe print date %finish %finish to gate(accept call, 0, p_tref, p_gref, null) %if msg_type # frig type(BIG) %start free buffer(msg) msg == get buffer(BIG) %finish info_tsbyte = 0; info_flag = x'86' msg_len = sizeof(info) info map(addr(msg_data_byte(0))) = info to gate(data, 1, p_tref, p_gref, msg); msg == null -> exit fn(accept call): %if p_tref = log line > 0 %start %if log state = TRYING %start reset failures send log queue head new log state(WORKING) %finishelse crash(12) %finishelse crash(13) -> exit fn(disconnect): %if p_tref = log line > 0 %start %if TRYING <= log state <= WORKING %start {new} to gate(disconnect, 1, p_tref, p_gref, null) %if log state = WORKING %if count failures = 10 %start forget addr(log line) log line = log line-1 %finish %if log line < log lines %start start line(log line+1) new log state(TRYING) %else %if log lines > 0 clock = interval new log state(WAITING) %else new log state(IDLE) %finish %elseif log state = CLOSING {new} to gate(disconnect, 1, p_tref, p_gref, null) %if log queue_count = 0 %start new log state(IDLE) %else start line(1) new log state(TRYING) %finish %finishelse crash(99) %else to gate(disconnect, 1, p_tref, p_gref, null) %finish -> exit fn(reset): %if p_tref = log line > 0 %start %if log state = WORKING %start to gate(reset, 1, p_tref, p_gref, null) %elseif log state = CLOSING {ignore} %finishelse crash(14) %else to gate(reset, 1, p_tref, p_gref, null) %finish -> exit fn(ack): %if p_tref = log line > 0 %start %if log state = WORKING %start %if log queue_count > 0 %start send log queue head %else {new} send invitation to clear new log state(CLOSING) %finish {new} %elseif log state = CLOSING {new} {ignore} %finishelse crash(15) %finish -> exit fn(*): { ignore } exit: free buffer(msg) %if msg ## null %end %routine clock interrupt !======================= %integer i %record (msgf) %name msg up date(period) %if clock > 0 %start clock = clock-1 %if clock = 0 %and log state = WAITING %start start line(1) new log state(TRYING) %finish %finish i = 0 %while i < log queue_count %cycle i = i+1 msg == pop(log queue) msg_data_secs = msg_data_secs+period msg_data_mins = msg_data_mins+1 %and msg_data_secs = msg_data_secs-60 %if msg_data_secs >= 60 push(log queue, msg) %repeat %end %routine console interrupt(%integer char) !======================================== %if char = 'V' %start print version %elseif char = '?' print info(info) %elseif char = '!' print log details %elseif char = 'M' mon = 1-mon %elseif char = 'T' %if log state = WAITING %start start line(1) new log state(TRYING) %finish %elseif char = 'G' queue log msg("Snoop test message") %elseif '0' <= char <= '6' lograte = 10*(char-'0') %finish %end %routine register name(%string (11) name) !======================================== %record (msgf) %name msg msg == get buffer(SMALL) string(addr(msg_data)) = name to gate(enable facility, 1, 0, 0, msg); msg == null %end %routine up date(%integer increment) !=================================== date_sec = date_sec + increment %while date_sec >= 60 %cycle date_sec = date_sec - 60 date_min = date_min+1 %if date_min = 60 %start date_min = 0 date_hour = date_hour+1 %if date_hour = 24 %start date_hour = 0 date_day = date_day+1 %finish %finish %repeat upsecs = upsecs + increment %while upsecs >= 3600 %cycle upsecs = upsecs - 3600 uptime = uptime + 1 %repeat dates = ""; maybe print date %end %routine make date string !======================== dates = "" dates=dates.myitos(date_day)."/" dates=dates.myitos(date_mon)."/" dates=dates.myitos(date_year)." " dates=dates.myitos(date_hour).":" dates=dates.myitos(date_min)." " %end %routine maybe print date !======================== %if lograte # 0 %and date_min # last min %and rem(date_min, lograte) = 0 %start print date string %finish %end %routine print date string !========================= last min = date_min make date string %if dates = "" print string(">>> ".dates) %if date_hour = 9 %and date_min = 0 %start printstring(", Uptime ="); write(uptime,0) %finish newline %end %predicate register addr(%string (63) address) !============================================= %integer line %string (63) s1, s2, s3 %if log lines < MAX LINES %and length(address) <= 63 %start %if address -> s1.(".").s2 %start %if s2 -> s2.(".").s3 %start address = s1.".".s2 %else address = s1 %finish %finish %if log lines = 0 %start line = 1 %else %for line = 1, 1, log lines %cycle %false %if log addr(line) = address %repeat %finish log lines = log lines+1; log addr(log lines) = address; %true %finishelse %false %end %routine forget addr(%integer line) !================================== %while line < log lines %cycle log addr(line) = log addr(line+1) log fail(line) = log fail(line+1) line = line+1 %repeat log addr(line) = "" log fail(line) = 0 log lines = log lines-1 %end %routine new log state(%integer state) !===================================== %if state # log state %start log state = state log line = 0 %if IDLE <= log state <= WAITING %if mon # 0 %start printstring("INFO: log state ="); write(state,0); newline %finish %finish %end %routine start line(%integer line) !================================= %record (msgf) %name msg clock = 0 push seg4 msg == get buffer(BIG) putstring(msg, log addr(line).".LOGGER") putstring(msg, "INFO") to gate(connect, 0, line, 0, msg) log line = line pop seg4 %end %routine queue log msg(%string (63) text) !======================================== %record (msgf) %name msg msg == get buffer(SMALL) string(addr(msg_data_byte(-1))) = text msg_len = length(text) p_server = own id msg_data_mins = 0 msg_data_secs = 0 p_reply = own id p_fn = LOGMSG p_buffno = addr(msg) pon(p) %end %routine putstring(%record (msgf) %name msg, %string (63) s) !=========================================================== %if msg_len+length(s) < SMALL SIZE %start string(addr(msg_param(msg_len))) = s msg_len = msg_len+1+length(s) %finish %end %string (255) %function getstring(%record (msgf) %name msg, %integer no) !======================================================================= %integer i,l %if msg ## null %start l=0 %while no > 1 %cycle l=l+msg_param(l)+1 %result = "" %if l >= msg_len no = no - 1 %repeat %if msg_param(l) > 63 %start %result = "Err/Too Long" %else %result = string(addr(msg_param(l))) %finish %else %result = "" %finish %end %string (15) %function myitos(%integer i) !======================================== temps = itos(100+rem(i, 100), 5) %result = substring(temps, length(temps)-1, length(temps)) %end %string (255) %function substring(%string (*) %name s, %integer i, j) !==================================================================== %ownstring (255) ss %if (0 < i <= length(s)) %and (i-1 <= j <= length(s)) %start charno(ss, 0) = 1+(j-i) move(1+(j-i), addr(s)+i, addr(ss)+1) %else ss = "" %finish %result = ss %end %routine move(%integer len,from,to) !================================== ! ! 'Assembler Routine' to emulate EMAS MOVE. ! Note: 1. No action if LEN<=0 ! 2. Registers 1,2 and 3 used. ! %label uploop, downloop, up, return ! *mov_len,1 ;! Load the length *ble_return ;! Return if less than or equal to zero *mov_from,2 ;! Load the FROM address *mov_to,3 ;! Load the TO address *cmp_3,2 ;!Is TO address > FROM address? *bgt_up ;!Yes - Move from top down in case... *beq_return ;!Move in place - Null function ! ! Loop to move LEN bytes FROM -> TO ! downloop: *movb_(2)+,(3)+ ;! Move the byte *sob_1,downloop ;! decrement & Continue if length not exhausted *br_return ! up: *add_1,2 *add_1,3 uploop: *movb_-(2),-(3) *sob_1,uploop return: %return %end ;!of Move %endofprogram