|
DataMuseum.dkPresents historical artifacts from the history of: RC3500 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC3500 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 8448 (0x2100) Types: TextFileVerbose Names: »lorec«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system └─⟦72244f0ef⟧ └─⟦this⟧ »lorec«
(******************************************************************) (* *) (* process local receiver *) (* ---------------------------------------------------------------*) (* *) (* ltrm: transmit semaphores for connectors in the node *) (* rtables: routing tables for levels 1, 2, ... rlmax *) (* queues: queue and state for each connector in the node *) (* netwtime: network time *) (* utrm_sem: main semaphore of the local receiver *) (* supv: supervisor semaphore *) (* cparams : transmit delay = (cpm(1)*2**cpm(2)) msec *) (* ext_rout_tab: extension level routing table (ELRT) *) (* index_elrt: index ELRT *) (* no_of_ext: number of extensions connected *) (* ownaddr: network address of this node *) (* c: connector number of this connector (index in *) (* arrays 1..cmax) *) (* *) (******************************************************************) process lorec( var sysvec:system_vector; var ltrm: !ltsmarray; var rtables: rtabarray; var queues: qinftable; var netwtime: nwtime; var ext_rout_tab: extrouttable; var index_elrt: indextab; var cparams: cparams_type; var utrm_sem: !tap_pointer; var supv: !tap_pointer; var no_of_ext: integer; var ownaddr: nwadr; c: integer); const version='ver. 810119/'; var z:zone; action_p: boolean; prejst: byte; daddr: nwadr; toprec,nextrec: integer; extindex: integer; dest: integer; msg: reference; timerhead: pool 1; timersem: semaphore; function check_p_form(var ref: reference; var extindex: integer; no_of_ext: integer; var index_elrt: indextab) : pack_error; (* The function checks the format of the specified reference ( packet ). If the extension number does not exist in the ELRT the function is equal to extunknown.If the format of the packet is illegal the function is equal to form_error.If ok the function is equal to form_ok and extindex holds the index in the ELRT. The procedure search_table is called.The following must be fulfilled: - ref^.size>=6+phead1_lgt+rparam_lgt - extension number must exist in ELRT - format = dg_form1 - if broadcast in facility then lifetime must be set too - priority ? - type is set to ext_user_p *) var i:integer; begin if ref^.size < 6+phead1_lgt +rparam_lgt then check_p_form:=form_error else begin lock ref as p: pack1 do with p do begin case search_table(rparam.rparam1,i,1,no_of_ext,index_elrt) of true: begin extindex:=index_elrt(i).index; if head.format <> dg_form1 then check_p_form:=form_error else begin if p.head.fac.bcast=1 then if (p.head.fac.timelt=0) and (p.head.fac.linklt=0) then check_p_form:=form_error else begin (* priority check ??? *) head.typ:=ext_user_p; check_p_form:=form_ok; end else check_p_form:=form_ok; end; end; false: check_p_form:=extunknown; end; (* case *) end; end; end; begin testopen(z,own.incname,sysvec(operatorsem)); testout(z,version,0); (* mangler: ----------------------------------------------*) (* evt andring af delay1,delay2 *) repeat wait(msg,utrm_sem.w^); case msg^.u2 of (*------------------------------*) (* message *) (*------------------------------*) message: begin (* message *) case msg^.u1 of (*------------------------------*) (* output *) (*------------------------------*) trm_packet,dir_transm: begin (* output *) case check_p_form(msg,extindex,no_of_ext,index_elrt) of (*------------------------------*) (* packet format ok *) (*------------------------------*) form_ok: begin (* packet format ok *) inc16(ext_rout_tab.tab(extindex).st.xmit); case msg^.u1 of (*------------------------------*) (* transmit packet *) (*------------------------------*) trm_packet: begin (* transmit packet *) lock msg as p: pack1 do begin (* lock *) if p.head.fac = fac_mask_0 then (*------------------------------*) (* no facility bits set *) (*------------------------------*) begin (* no facility bits set *) get_addr(p,daddr); action_p:=masterroute(p,dest,ownaddr,daddr,rtables,queues); end else (*------------------------------*) (* facility bits set *) (*------------------------------*) begin (* facility mask set *) toprec:=p.data(p.head.top_of_data+top_of_trail+1); nextrec:=p.data(p.head.top_of_data+next_rec+1); case check_facility(p,rtables,toprec,nextrec,dest,daddr ,ownaddr,prejst,netwtime,0) of reject_p: begin (* reject packet *) if reject(p,prejst) then begin get_addr(p,daddr); action_p:=masterroute(p,dest,ownaddr,daddr,rtables,queues); end else action_p:=false; end; (* reject packet *) route_p: action_p:=masterroute(p,dest,ownaddr,daddr,rtables,queues); route_to_dest: begin action_p:=true; update_queue(queues,dest,1); end; route_to_sup: begin dest:=-1; action_p:=true; end; end; (* case check facility *) end; (* facility bits set *) end; (* lock msg *) if action_p then (*------------------------------*) (* route packet *) (*------------------------------*) begin (* route packet *) if dest=-1 then begin msg^.u3:=c; signal(msg,supv.s^); end else signal(msg,ltrm(dest).s^); end (* route packet *) else (*------------------------------*) (* return packet *) (*------------------------------*) begin (* return packet *) msg^.u2:=ok; (* ??????? *) return(msg); end; (* return packet *) end; (* transmit packet *) (*------------------------------*) (* directed transmit *) (*------------------------------*) dir_transm: begin (* directed transmit *) dest:=msg^.u3; (* read connector number *) if (dest<1) or (dest>cmax) then begin (* connector no illegal *) msg^.u2:=conn_unkn; return(msg); end (* connector no illegal *) else begin (* route packet *) if queues.state(dest)=not_crea then begin (* connector illegal *) msg^.u2:=conn_unkn; return(msg); end else begin lock msg as p:pack1 do begin (* lock *) if p.head.fac.trace=1 then begin (* trace bit set *) toprec:=p.data(p.head.top_of_data+top_of_trail+1); nextrec:=p.data(p.head.top_of_data+next_rec+1); place_trace(p,toprec,nextrec,netwtime,ownaddr); end; (* trace bit *) end; (* lock *) signal(msg,ltrm(dest).s^); update_queue(queues,dest,1); end; end; (* route packet *) end; (* directed transmit *) end; (* case msg^.u1 *) (*------------------------------*) (* wait a bit *) (*------------------------------*) if cparams(4)<>0 then begin alloc(msg,timerhead,timersem); msg^.u2:=message; msg^.u3:=cparams(4); msg^.u4:=cparams(5); sendtimer(msg); wait(msg,timersem); release(msg); end; end; (* packet format ok *) (*------------------------------*) (* packet format eror *) (*------------------------------*) form_error: begin (* packet format error *) msg^.u2:=ill_p_form; return(msg); end; (* packet format error *) (*------------------------------*) (* extension no unknown *) (*------------------------------*) extunknown: begin (* ext no unknown *) msg^.u2:=ext_unkn; return(msg); end; (* ext no unknown *) end; (* case check_p_form *) end; (* output *) otherwise (*------------------------------*) (* unknown functions *) (*------------------------------*) begin (* unknown functions *) msg^.u2:=illegal; return(msg); end; (* unknown function *) end; (* case msg^.u1 *) end; (* message *) otherwise (*------------------------------*) (* answer *) (*------------------------------*) release(msg); (* error *) end; (* case msg^.u2 *) until false; end. (* process lorec *) «eof»