%control 1 #if ~x #if n #report NSI version #else #report ring version #fi #else #report ts version #fi %include "ercm09.b_deimosspecs" #if ~b %conststring (9) vsn = "FTPQ..1o " #else %conststring (19) vsn = "FTPQ..1o (on FTQ) " #fi %begin %externalstring (255) %fnspec cli param #datestring #timestring #if ~x #if n %constinteger lev3 header len = 6 %recordformat lev3f(%byteinteger fn,sufl,st,ss, (%byteinteger flag,uflag, %c #else %constinteger lev3 header len = 2 %recordformat lev3f(%integer a, b, c, d, (%integer uflag, %c #fi (%byteintegerarray data(0:237) %or %string(200) dst) %or %c (%byteinteger sn,dn,dt,ds,mflg,ufl,%string(200) s))) #else %constinteger lev3 header len = 0 #if ~b %recordformat lev3f(%integer a, b, c, d, (%bytearray data(0:199) %or %c #else %recordformat lev3f(%integer a, b, c, (%bytearray data(0:199) %or %c #fi %string (200) dest)) #fi #if ~b %recordformat mef(%record (mef) %name link, %c %byteinteger len, type, (%record (lev3f)lev3 %or %c %bytearray params(0:231) %or %string (231) str)) #else %recordformat mef(%integer buff no, len, %c %byteinteger owner, type, (%record (lev3f)lev3 %or %c %bytearray params(0:231) %or %string (231) str)) #fi #if x #if ~b %recordformat pef(%byteinteger ser, reply, %c (%integer a, b, (%integer c %or %byte c1, c2) %or %byte fn, a2, %c (%record(mef)%name mes, %byte gate port, task port %or %c %string (3) facility))) #else %recordformat pef(%byteinteger ser, reply, %c (%integer a, b, (%integer c %or %byte c1, c2) %or %byte fn, a2, %c (%integer buff no, %byte gate port, task port %or %c %string (3) facility))) #fi #else %recordformat pef(%byteinteger ser,reply,fn,port, %c (%record(mef)%name mes, %byteinteger len,s1 %or %c %byteinteger facility,flag,node,term)) #fi %ownrecord(pef) p %ownrecord(lev3f) %name lev3 %ownrecord (mef) %name mes %recordformat parmf(%integer type, int, %string (255) s) %record (parmf) par ! constants %constinteger eot=4 %constinteger in = 0, out = 1 #if ~x ! gate to task functions %constinteger incomming call=2 %constinteger input here=3 %constinteger output txd=4 %constinteger call closed=5 %constinteger call aborted=6 %constinteger open reply a=7 %constinteger open reply b=8 %constinteger open message=9 ! task to gate functions %constinteger enable facility=1 %constinteger disable facility=2 %constinteger call reply=3 %constinteger enable input=4 %constinteger put output=5 %constinteger close call=6 %constinteger abort call=7 %constinteger open call=8 %constinteger message reply=10 #else %include "b_ygatecalls" #fi !other gate constants %constinteger ftp facility = 16 #if ~x %constinteger accept = x'24' %constinteger reject = 0 #fi ! service numbers #if ~x %constinteger gate service=16 #else %constinteger gate service = 24 #fi %constinteger buffer manager=17 %constinteger request buffer=0 %constinteger release buffer=1 %constrecord (*) %name null==0 !gate variables and states %constinteger idle = 0 %constinteger active = 1 %constinteger closing = 2 %constinteger aborting = 3 %integer gstate !in stream variables and states %constinteger await input = 0 %constinteger process input = 1 %constinteger input pending = 2 %constinteger input closed = 3 %constinteger eob = -1 %constinteger eor = 256 %integer instate; !state of connection wrt input %integer inptr; !current position in input buffer %integer inlen; !length of current input buffer %integer RCBin; !RCB or SRCB of current input record %record(mef) %name inbuff; !current input buffer %record(mef) %name pend; !pending input buffer !output stream variables and states %constinteger await buffer = 0 %constinteger await output = 1 %constinteger blocked = 2 %constinteger outbuffer length = 237 %integer outstate; !state of connection wrt output %integer outptr; !current position in output buffer %integer outlen; !length of current output buffer %integer RCBoutptr; !current RCB position in buffer %record(mef) %name outbuff; !current output buffer #if b %owninteger in buff no, out buff no; ! hold the buffer numbers %record (mef) %mapspec map4(%integer buff no) %record (mef) %mapspec map2(%integer buff no) #fi %routinespec push(%integer flag) !analyser state %integer state !other variables %OWNINTEGER CONTIG = 0; !monitor packing %OWNINTEGER GATE MON = 0; !gate monitor control %OWNINTEGER FTP MON = 0; !ftp monitor control %owninteger out stream; !file output stream %owninteger gate port = 0 %integer temp !compiler fixup routines %string(255) %map string(%byteintegername addr) %recordformat f(%string(255) %name s %or %byteintegername b) %record(f) r r_b == addr %result == r_s %end !error reporting routine %string(255) %fn itos(%integer x) %result = "" %end %routine message(%string(63) s) select output(0) NEWLINE %AND CONTIG = 0 %IF CONTIG # 0 printstring("ftp: ".s) newline select output(out stream) %end !routine to analyse and handle ftp protocol %integerfn inchar %signal 13, 1 %if RCBin = 128; !eor %signal 13, 0 %if inptr >= inlen; !eob %if RCBin = 0 %thenstart; !end of sub-record RCBin = inbuff_lev3_data(inptr) %signal 13, 1 %if RCBin = 0 inptr = inptr+1 %result = inchar %finish RCBin = RCBin-1 inptr = inptr+1 %result = inbuff_lev3_data(inptr-1) %end %routine outchar(%integer char) push(0) %andsignal 13, 0 %if outptr >= outlen outbuff_lev3_data(outptr) = char outptr = outptr+1 %end %routine analyse %integer tok, val %owninteger level, char, arinptr, aroutptr, attptr, stringptr %ownstring(255) %name file name %ownintegerarray counter(0:2) = 0(*) %ownintegerarray stack(0:9) = 0(*) %ownbyteintegerarray ar(1:100) = 0(*) %switch act(0:22), actb(0:6) %constbyteintegerarray token(0: 125)=0, 35, 203, 76, 77, 78, 79, 80, 63, 81, 82, 166, 211, 84, 165, 166, 84, 85, 80, 64, 38, 24, 39, 47, 168, 0, 129, 130, 131, 132, 133, 134, 135, 136, 137, 139, 140, 141, 142, 143, 144, 145, 146, 147, 43, 161, 34, 31, 33, 33, 33, 33, 33, 32, 32, 86, 88, 86, 86, 86, 86, 86, 86, 87, 88, 56, 55, 59, 58, 60, 57, 61, 62, 54, 172, 0, 43, 43, 41, 170, 0, 43, 41, 170, 0, 44, 38, 21, 30, 45, 30, 26, 30, 45, 30, 27, 45, 30, 28, 65, 66, 65, 73, 38, 20, 158, 39, 168, 0, 138, 19, 31, 32, 86, 88, 55, 54, 71, 67, 198, 72, 71, 68, 65, 71, 69 %constbyteintegerarray next(0: 125)=0, 2, 4, 5, 6, 7, 8, 9, 10, 0, 11, 14, 15, 17, 14, 14, 17, 18, 19, 9, 21, 22, 23, 24, 26, 0, 47, 48, 49, 50, 51, 51, 52, 51, 52, 49, 53, 54, 54, 54, 54, 54, 51, 54, 45, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 65, 66, 67, 68, 69, 70, 71, 72, 73, 24, 24, 24, 24, 24, 24, 24, 24, 24, 74, 0, 77, 0, 79, 81, 0, 79, 83, 85, 0, 83, 87, 88, 74, 90, 91, 92, 0, 94, 95, 77, 97, 98, 92, 100, 101, 102, 0, 104, 105, 0, 107, 109, 0, 111, 112, 113, 114, 115, 116, 107, 107, 118, 119, 119, 0, 122, 123, 120, 125, 123 %constbyteintegerarray value(1: 88) = %C 0, 1, 2, 3, 5, 6, 11, 13, 14, 15, 32, 64, 66, 68, 69, 74, 75, 96, 113, 0, 1, 2, 3, 4, 5, 64, 66, 67, 71, 0, 34, 50, 32, 48, 0, 0, 0, 0, 1, 1, 2, 2, 0, 0, 0, 1, 0, 0, 0, 1, 128, 0, 3, 3, 4, 48, 49, 50, 53, 51, 52, 1, 0, 0, 0, 71, 2, 3, 5, 0, 0, 0, 0, 1, 20, 74, 117, 121, 86, 103, 124, 89, 93, 96, 99, 76, 78, 82 %constbyteintegerarray action(1: 88) = %C 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4, 8, 9, 15, 6, 5, 7, 5, 7, 2, 3, 16, 16, 17, 7, 23, 34, 34, 34, 35, 18, 18, 19, 19, 19, 19, 19, 19, 20, 21, 22, 11, 11, 11, 11, 11, 14, 10, 12, 13, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 !End of tables %predicate test attribute(%integer n) !for integer attributes !compare given operator and value with expected op and value !and decide if ok. expected values are in action and value resp. %integer qual, xop, x, yop, y, good %integerfn comp(%integer op, x, y) !should be predicate %result = 1 %if op&1 # 0 %and x < y %result = 1 %if op&4 # 0 %and x > y %result = 1 %if op&2 # 0 %and x = y %result = 0 %end qual = ar(attptr) xop = qual&x'37' x = ar(arinptr-2)<<8+ar(arinptr-1); !given value yop = action(n); !expected op y = value(n); !expected value good = 0 %if xop = X'22' %or yop&7 = 7 %thenstart; !attribute given good = comp(yop, x, y) %finishelseif yop = X'22' %or xop&7 = 7 %thenstart; !attribute expected good = comp(xop, y, x) %finish %if qual&128 # 0 %or xop = X'21' %or X'23' <= xop <= X'26' %or yop = 7 %c %thenstart; !if monitor or choice or unknown ar(aroutptr) = ar(aroutptr)+1; !count parameters ar(attptr) = yop; !insert expected op in ar %if yop&X'20' # 0 %thenstart; !insert expected value in ar ar(attptr+1) = 0; ar(attptr+2) = y %finishelse arinptr = attptr+1; !drop given value %finishelse arinptr = attptr-1; !drop attribute %if good # 0 %thentrue %elsefalse %end; !test attribute %ROUTINE FTP MONITOR !monitor state transitions and inputs %OWNINTEGER MON LEVEL %RETURNIF FTP MON = 0 %OR ACTION(TOK) = 15 SELECT OUTPUT(0) %IF CONTIG&15 = 0 %OR LEVEL # MON LEVEL %THENSTART NEWLINE; PRINTSTRING("A:"); SPACES(LEVEL*2) CONTIG = 0; MON LEVEL = LEVEL %FINISH WRITE(STATE, 1); WRITE(VAL, 1) CONTIG = CONTIG+1 SELECT OUTPUT(OUT STREAM) %END %onevent 13 %start !sub events used are 0 - eob or buffer full 1 - eor %if event_sub = 0 %thenreturn %else -> fail %finish %returnif state = 0; !analysis finished CONTIG = 0 loop: tok = token(state)&127 val = value(tok) -> act(action(tok)) succeed:FTP MONITOR %IF FTP MON # 0 state = next(state) -> loop %unless state = 0 end: state = stack(level); !sub-phrase analysis succeeds level = level-1 -> succeed %unless state = 0 message("analysis succeeds"); !main phrase analysis succeeds %return fail: FTP MONITOR %IF FTP MON # 0 %if token(state)&128 # 0 %thenstart state = state+1 %if token(state) = 0 %then -> end %else -> loop %finish state = stack(level); !sub-phrase analysis fails level = level-1 -> fail %unless state = 0 message("analysis fails"); !main phrase analysis fails %return act(1): !analyse a sub-phrase level = level+1 stack(level) = state state = val -> loop act(8): !initialise level = 1; char = -1; arinptr = 1; aroutptr = 3 out stream = 0; stack(0) = 0 -> succeed act(9): !terminate CONTIG = 0 FTP MONITOR %stop !inputs act(6): !RCB input - read everything mode RCBin = -1 act(0):act(2):act(3):act(4):act(5):! character input char = inchar %if char < 0 -> actb(action(tok)) actb(0): !test character %if char = val %then -> accept %else -> fail actb(2):accept: !accept character to analysis record ar(arinptr) = char arinptr = arinptr+1 actb(3):discard: !discard character VAL = CHAR char = -1 -> succeed actb(4): !test for comparator attptr = arinptr %if char&x'30' = val %then -> accept %else -> fail actb(5): !set counter stringptr = arinptr counter(val) = char -> accept actb(6): !set RCB - back to read record mode -> fail %if char = 0 RCBin = char -> discard act(7): !test and decrement counter -> fail %if counter(val) = 0 counter(val) = counter(val)-1 -> succeed act(16): !change input mode - read everything RCBin = -1 -> succeed act(17): !append val to analysis record ar(arinptr) = val arinptr = arinptr+1 -> succeed !outputs act(10): !output RCB RCBoutptr = outptr act(11): !output val as character outchar(val) -> succeed act(12): !EOR push(128) -> succeed act(13): !push push(-1) -> succeed act(14): !output analysis record -> fail %if aroutptr >= arinptr VAL = AR(AROUTPTR) outchar(ar(aroutptr)) aroutptr = aroutptr+1 -> succeed !transfers act(15): !transfer data char printsymbol(inchar) -> discard !test attributes act(18): !drop attribute (val bytes long) from analysis record arinptr = arinptr-val -> succeed act(19): !test integer attribute %if test attribute(val) %then -> succeed %else -> fail act(20): !set file name file name == string(ar(stringptr)) message("file name = ".file name) -> succeed act(21): !open output file message("opening output file ".file name) open output(1, file name) out stream = 1 select output(1) -> succeed act(22): !close output file message("closing output file") close output out stream = 0 -> succeed %end !gate interface routines %ROUTINE GATE MONITOR(%INTEGER INOUT) %INTEGER I %RECORD(MEF) %NAME MONBUFF %CONSTSTRING(10) %ARRAY TOFROM(0:1) = "From gate:", "To gate:" %RETURNIF GATE MON = 0 SELECT OUTPUT(0) NEWLINE %AND CONTIG = 0 %IF CONTIG # 0 PRINTSTRING(TOFROM(INOUT)); WRITE(P_FN, 1) #if ~x PRINTSTRING(" port"); WRITE(P_PORT, 1) #else printstring(" port"); write(p_gate port, 1) #fi NEWLINE %IF (INOUT = IN %AND P_FN = INPUT HERE) %OR (INOUT = OUT %AND %C P_FN = PUT OUTPUT) %THENSTART #if ~b MONBUFF == P_MES #else %IF INOUT = IN %THEN MONBUFF == MAP2(P_BUFF NO) %ELSE %C MONBUFF == MAP4(P_BUFF NO) #fi %FOR I = 1, 1, MONBUFF_LEN %CYCLE NEWLINE %IF I&15 = 0 WRITE(MONBUFF_LEV3_DATA(I-1), 1) %REPEAT NEWLINE %FOR I = 1, 1, MONBUFF_LEN %CYCLE %IF I&15 = 0 %THEN NEWLINE %ELSE SPACE %IF 32 <= MONBUFF_LEV3_DATA(I-1) < 127 %THEN %C PRINTSYMBOL(MONBUFF_LEV3_DATA(I-1)) %ELSE SPACE %REPEAT NEWLINE %FINISH SELECT OUTPUT(OUT STREAM) %END #if x %routine do enable facility(%string (11) address) p_ser = gate service; p_reply = own id p_fn = enable facility; p_a2 = 0 p_facility = address pon(p) %end %string (127) %fn unpack(%record (mef) %name mes, %integer no) %integer i, l %unless mes == null %or mes_len<=0 %or no<=0 %start l = 0 %while no>1 %cycle l=l+mes_params(l)+1 no = no-1 %repeat %result = string(mes_params(l)) %finish %else %result = "" %end #fi #if b %record (mef) %map map4(%integer buff no) ! New compiler - so must get 0 %result == null %if buff no = 0 *mov_1,0 *mov_#8,1; ! desired vm seg no *2 ie 4*2 *iot %result == record(k'100000') %end %record (mef) %map map2(%integer buff no) ! New compiler - so must get 0 %result == null %if buff no = 0 *mov_1,0 *mov_#4,1; ! desired vm seg no *2 ie 2*2 *iot %result == record(k'040000') %end #fi %routine ask for buffer p_ser = buffer manager; p_reply = id #if ~x p_fn = request buffer; p_len = 0 #else p_fn = request buffer; p_gate port = 0 #fi pon(p) %end %routine free buffer p_ser = buffer manager; p_reply = id p_fn = release buffer pon(p) %end %routine to gate(%integer fn) p_ser = gate service; p_reply = id p_fn = fn #if x p_task port = 1; p_gate port = gate port #fi GATE MONITOR(OUT) %IF GATE MON # 0 pon(p) %end %routine to gate2(%integer fn, param) #if ~x p_s1 = param #else p_a2 = param #fi to gate(fn) %end %routine handle inbuffer(%record (mef) %name buff) %if buff ## null %thenstart; !new input buffer inbuff == buff inptr = 0; inlen = buff_len-lev3 header len %finish analyse; !handle rest of buffer character at a time ! %if inptr >= inlen %and instate = input pending %thenstart; !handle pending input ! instate = process input ! to gate(enable input) ! handle inbuffer(pend) ! %finish %if inptr >= inlen %AND INSTATE = PROCESS INPUT %thenstart; !reactivate input instate = await input #if ~x TO GATE(ENABLE INPUT) #else #if ~b p_mes == inbuff free buffer; inbuff == null p_mes == null #else p_buff no = inbuff no free buffer; inbuff == null; inbuff no = 0 p_buff no = 0 #fi to gate2(Enable Input, 1) #fi %finish %end; !handle inbuffer %routine handle outbuffer %if outstate # await buffer %thenstart message("unexpected buffer") free buffer %finishelsestart outstate = await output #if ~b outbuff == p_mes #else outbuff no = p_buff no outbuff == map4(out buff no) #fi outptr = 0; outlen = outbuffer length handle inbuffer(null); !handle suspended input %finish %end; !handle outbuffer %routine push(%integer flag) %returnif outstate # await output outbuff_lev3_data(RCBoutptr) = outptr-RCBoutptr-1+flag %if flag >= 0 outlen = outptr; !and mark output buffer full outbuff_len = outlen+lev3 header len #if ~b p_mes == outbuff #else p_buff no = outbuff no; out buff no = 0 outbuff == null #fi to gate(put output) outstate = blocked %end %routine handle gate #if ~x %switch f(incomming call:message reply) #else %switch f(Connect:control data) #fi GATE MONITOR(IN) %IF GATE MON # 0 -> f(p_fn) #if ~x f(incomming call): %if instate # idle %then to gate2(call reply, reject) %elsestart to gate2(call reply, accept) #else f(Connect): %if instate # idle %then to gate2(Disconnect, x'fd') %else %start #if ~b mes == p_mes #else mes == map2(p_buff no) #fi printstring("Call from "); printstring(unpack(mes, 2)) printstring(" Qual:"); printstring(unpack(mes, 3)) newline #if ~b free buffer; p_mes == null #else free buffer; p_buff no = 0 #fi gate port = p_gate port to gate2(Accept call, 0) #fi state = 1; ! bg mod 14 sep 84 inbuff == null; ! ??????? gstate = active instate = await input outstate = await buffer; ask for buffer %finish %return f(input here): %if instate = await input %thenstart instate = process input ! to gate(enable input) #if ~b handle inbuffer(p_mes) #else inbuff no = p_buff no handle inbuffer(map2(p_buff no)) #fi %finishelsestart ! instate = input pending ! pend == p_mes %finish %return #if x f(Disconnect): free buffer #if ~b p_mes == null #else p_buff no = 0 #fi #else f(call closed): message("unexpected call close") to gate(close call) gstate = idle %return f(call aborted): #fi %if gstate = aborting %thenstart message("abort acknowledged") %finishelseif gstate = active %thenstart #if ~x to gate(abort call) #else to gate2(Disconnect, 0) #fi message("call closed") gstate = idle %finish %return #if ~x f(output txd): #else f(Enable Output): #fi %if outstate = blocked %thenstart ask for buffer outstate = await buffer %finishelse message("unexpected output ack") %return #if x f(Reset): to gate2(Disconnect, x'f0') gstate = aborting %return #fi f(*): message("illegal fn from gate".itos(p_fn)) %return %end; !handle gate temp = map virt(buffer manager, 6, 5) temp = map virt(buffer manager, 5, 4) state = 1 #if ~x to gate2(enable facility, ftp facility) #else #if ~b do enable facility("FTP") #else do enable facility("FTQ") #fi #fi %cycle p_ser = 0; poff(p) %if int # 0 %start %if int = '?' %start printstring("Gstate ="); write(gstate, 1) printstring(", State ="); write(state, 1) newline %finish %if int = 'G' %then gate mon = 1-gate mon %if int = 'F' %then ftpmon = 1-ftpmon int = 0 %finish %if p_reply = buffer manager %then handle outbuffer %else %c %if p_reply = gate service %then handle gate %else %c message("duff pon".itos(p_reply)) %repeat %endofprogram