DataMuseum.dk

top - metrics - download

    Length: 5376 (0x1500)
    Types: TextFile
    Names: »fesupjob«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »fesupjob« 

TextFile

job jg 3 200 time 11 0 area 10 size 100000
(source=copy 25.1
fesuplst= set 1 disc1
fesuperr=set 1 disc1
fesuplst= indent source mark lc
listc= cross fesuplst
o fesuperr
head 1
message fesup program
pascal80 spacing.3000 codesize.3000 evaenv alarmenv paxenv fetsaosenv source
o c
lookup pass6code
if ok.yes
(fesupbin=set 1 disc1
fesupbin=move pass6code
scope user fesupbin
)
fesuplst=copy listc fesuperr
scope user fesuplst
scope user fesuperr
finis output.no
)
process fesupervisor(
op_sem : sempointer;
var input_sem, write_sem, que_up, que_down : !ts_pointer;
var stream_sem, netc_sem, com_pool : !sempointer);
const
version = "vers  1.11 /";
no_read_stream  = 3;
no_write_stream = 3;
no_trans_bufs   = no_read_stream + no_write_stream;
stream_mark = 255;        (* u4 *)
dummy_stream = 2;
max_stream_no = 15;
  
type
tty_data = array ( 1..data_length ) of byte;
stream_buf = packed record
             fi, la, ne : integer;
             fix        : alarmlabel;
             data       : tty_data;
            dummy      : array ( 1..106-data_length ) of byte
             end;
return_buf= packed record
            fi, la, ne : integer;
            fix        : alarmlabel;
            data       : alarmlabel;
            end;
alarm_buf = packed record
            alabel : alarmlabel;
            adata  : tty_data;
            end;
netc_buf = packed record
           alabel : alarmlabel;
           intg   : integer;
           netc_macro : macroaddr;
           end;
streams = set of 0..max_stream_no;
  
var
i      : byte;
msg,
alarm_msg : reference;
opzone : zone;
trans_pool : pool no_trans_bufs of stream_buf;
akt_streams : streams := (. 1, 2, 4 .);
netc_addr : alarmnetaddr := alarmnetaddr(macroaddr(0,0,0),3);
\f


procedure send_read_stream( no: byte );
begin
lock msg as buf : stream_buf do
with msg^, buf do
begin
u1:= read_stream;
u2:= 0;
u3:= no;
u4:= stream_mark;
fi:= 6;
la:= 6+data_length;
ne:= 6;
end;
signal( msg, stream_sem^ );
end;
  
procedure send_to_netc;
begin
sensesem( alarm_msg, com_pool^ );
if nil ( alarm_msg ) then
signal( msg, que_down.s^ ) else
begin
lock msg as buf : stream_buf do
lock alarm_msg as abuf : alarm_buf do
with alarm_msg^, buf, abuf do
begin
if fix.rec = netc_addr then
u3:= netc_route1 else
u3:= netc_route;
u4:= fix.op_code;
alabel:= fix;
adata := data;
end;
signal( alarm_msg, netc_sem^ );
if msg^.u1 = read_stream then
send_read_stream ( msg^.u3 ) else
signal( msg, write_sem.s^ );
end;
 
end;
\f


procedure send_write_stream;  (* data to sm3502 in msg *)
var
rec_stream : integer;
begin
sensesem( alarm_msg, write_sem.w^ );
if nil ( alarm_msg ) then
signal( msg, que_up.s^ ) else
begin
lock msg as buf : alarm_buf do
lock alarm_msg as sbuf : stream_buf do
with alarm_msg^, buf, sbuf do
begin
rec_stream:= alabel.rec.micro mod 256;
if rec_stream in akt_streams then
u3:= rec_stream else
u3:= dummy_stream;
u1:= write_stream;
u2:= 0;
u4:= stream_mark;
fix:= alabel;
data:= adata;
fi:= 6;
la:= 8 + alabel.no_of_by;
ne:= la + 1;
end;
if msg^.u3 = netc_route2 then
lock msg as buf : netc_buf do
with buf do
if (alabel.result=accepted) and (intg=1) then
netc_addr.macro:= netc_macro;
signal( alarm_msg, stream_sem^ );
return( msg );
end;
end;
\f


procedure write_returned; (* writebuf returned from sm3502 *)
begin
if msg^.u2 = ok_result then
signal( msg, write_sem.s^ ) else
 (* sm3502 error, return buf *)
begin
lock msg as buf : return_buf do
with msg^, buf do
begin
data:= fix;
fix.no_of_by:= 2*label_size+2;
fix.rec     := data.send;
fix.send    := data.rec;
fix.send.micro:= tss_mic_addr;
fix.op_code := #h12;
fix.update  := 0;
fix.result  := no_connection;
end;
send_to_netc;
end;
end;
\f


(* main program *)
begin
testopen( opzone, own.incname, op_sem );
testout ( opzone, version, fe_env_version );
for i:= 0 to max_stream_no do
if i in akt_streams then
begin
alloc ( msg, trans_pool, input_sem.s^ );
send_read_stream(i);
alloc( msg, trans_pool, input_sem.s^ );
signal( msg, write_sem.s^ );
end;
 
  
repeat (* forever *)
   
wait( msg, input_sem.w^ );
if ownertest( trans_pool, msg ) then
begin  (* from streamer *)
if msg^.u1 = read_stream then
send_to_netc else
write_returned;
end else
send_write_stream;
 
if open( que_up.w^) and open( write_sem.w^) then
begin (* write a qued message on stream *)
wait( msg, que_up.w^);
send_write_stream;
end;
 
if open( que_down.w^) and open( com_pool^) then
begin
wait( msg, que_down.w^);
send_to_netc;
end;
  
until false
  
end. (* process fesup *)
▶EOF◀