DataMuseum.dk

Presents historical artifacts from the history of:

RC3500

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC3500

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦596a155bb⟧ TextFileVerbose

    Length: 4608 (0x1200)
    Types: TextFileVerbose
    Names: »osifjob«

Derivation

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

TextFileVerbose

job jg 4 200 time 11 0 area 10 size 100000
(source=copy 25.1
osiflst= set 1 disc1
osiferr=set 1 disc1
osiflst= indent source mark lc
listc= cross osiflst
o osiferr
head 1
message osif program
pascal80 spacing.3000 codesize.3000 evaenv alarmenv paxenv feaosenv source
o c
lookup pass6code
if ok.yes
(osifbin=set 1 disc1
osifbin=move pass6code
scope user osifbin
)
osiflst=copy listc osiferr
scope user osiflst
scope user osiferr
finis output.no
)

process osif (
        op_sem  : sempointer;
var  input_sem  : !ts_pointer;
var stream_sem,
       lam_sem  : !sempointer;
       stream_no,
  no_stream_bufs,
     no_tty_bufs,
        portno  : byte );
  
const
version = "vers  1.07 /";
 
tty_read    = 1;  (* rutes of bufs , u4 *)
tty_write   = 2;
stream_read = 3;
stream_write= 4;
stream_buf  = 5;
tty_buf     = 6;
txt_max     = 24;
  
type
transmit_buf = record
               fi, la, ne : integer;
               fix : alarmlabel;
               data : array ( 1..256 ) of char;
               end;
error_txt = array(0..txt_max) of char;
const
discon = error_txt
("d","i","s","c","o","n","n","e","c","t","e","d",11***" ",cr,nl);
var
i,j    : integer;
msg  : reference;
opzone : zone;
no_trans_bufs : integer := 6;
trans_pool : pool 6 of transmit_buf;
base : integer;
\f


procedure send_read_tty;
begin
lock msg as buf : transmit_buf do
with msg^, buf do
begin
u1:= read_tty;
u2:= tty_port;
u3:= 19;
u4:= tty_read;
fi:= 3 + label_size;
la:= tty_length;
ne:= 3 + label_size;
end;
signal( msg, lam_sem^ );
end;
  
procedure send_read_stream;
begin
lock msg as buf : transmit_buf do
with msg^, buf do
begin
u1:= read_stream;
u2:= 0;
u3:= stream_no;
u4:= stream_read;
fi:= 6;
la:= 239;
ne:= 6;
end;
signal( msg, stream_sem^ );
end;
\f


procedure tty_to_stream;
begin
lock msg as buf : transmit_buf do
with msg^, buf do
begin
u1:= write_stream;
fix.result:= u2;
u3:= stream_no;
if u4=tty_write then
u4:= stream_buf else
u4:= stream_write;
fi:= 6;
la:= tty_length+6;
ne:= ne + 6;
end;
signal( msg, stream_sem^ );
end;
  
procedure stream_to_tty;
begin
lock msg as buf : transmit_buf do
with msg^, buf do
begin
i:= u2;
u1:= write_tty;
u2:= tty_port;
u3:= 20;
if u4=stream_write then
u4:= tty_buf else
u4:= tty_write;
fi:= 3 + label_size;
la:= fi + fix.no_of_by - 14(*label*) - 1;
ne:= 3 + label_size;
if i<>ok_result then
begin
la:= fi+txt_max;
for j:=0 to txt_max do
data(1+j):= discon(j);
if u4=tty_buf then
data(14):= "X" else
data(14):= "R";
base:= 128;
for j:=0 to 7 do
begin
if (base and i) = base then
data(16+j):= "1" else
data(16+j):= "0";
base:= base div 2;
end;
end;
end;
signal( msg, lam_sem^ );
end;
\f


(* main program *)
begin
testopen( opzone, own.incname, op_sem );
testout ( opzone, version, fe_env_version );
alloc( msg, trans_pool, input_sem.s^ );
repeat
lock msg as buf : create_shape do
with msg^, buf do
begin
u1:= create_tty_ch;
u2:= tty_port;
u3:= 33;       (* <>0 *)
contr:= tty_control;
timer:= 60;
end;
signal( msg, lam_sem^ );
wait( msg, input_sem.w^ );
until msg^.u2 = 0;
release( msg );
for i:=1 to no_trans_bufs do
begin
alloc( msg, trans_pool, input_sem.s^ );
if i<=no_tty_bufs then
send_read_tty else
send_read_stream;
end;
repeat (* forever *)
wait( msg, input_sem.w^ );
with msg^ do
case u4 of
tty_read  : (* data from tty *)
            if u2<>timeout_err then tty_to_stream
            else send_read_tty;
tty_write : (* result from write tty *)
if u2=ok_result then send_read_stream
else tty_to_stream;
stream_read : (* data from streamer *)
            stream_to_tty;
stream_write : (* result from write stream *)
            if u2=ok_result then send_read_tty
            else stream_to_tty;
tty_buf : send_read_tty;
stream_buf : send_read_stream;
otherwise return( msg )
   
end (* case u4 *)
until false
end. (* process osif *)
«eof»