DataMuseum.dk

top - metrics - download

    Length: 7680 (0x1e00)
    Types: TextFileVerbose
    Names: »txtfpa«

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

TextFileVerbose

process fpadriver(
  var sem : ! ts_pointer; level, blocktime : integer; rec: boolean;
  op : sempointer);
  
const
polltime =156; pollexp=6;  (* 9.984sec *)

sensecom    = 0;
resetcom    = 4;
autocom     = 8;
timeransw   = 5;
readcom     = 1;
writecom    = 2;
writereadcom= 3;
  
ok_result = 0;
rejected  = 1;
soft_error= 2;
(*         *) parity            = 8;
(*         *) timeout           =16;
(*         *) combined_write    =32;
(*         *) blocklength_error =64;
(*         *) receiver_not_ready=128;
hard_error= 3;
(*         *) disconnected      = 8;
(*         *) reset             =16;
(*         *)(*combined_write   =32*)
(*         *) autoload          =64;
unintelligible= 4;
(*         *) bad_message       = 8;
(*         *)(*combined_write   =32*)
  
small_size=08;
medium_size=768;
large_size=2048;
max_size  =4096;
small_max =small_size + 5;
medium_max=medium_size+ 5;
large_max =large_size + 5;
  
type
priority_table=packed array(ok_result..unintelligible) of 0..7;
stype=packed record
uu1: 0..1023;
ctmo,uu2: 0..1;
stp:0..7;
prty: 0..1;
end;

smallbuf=record first,last,next: integer;
c: packed array (6..small_max) of byte;
end;

mediumbuf= record first,last,next: integer;
c: packed array (6..medium_max) of byte;
end;

largebuf= record first,last,next: integer;
c: packed array (6..large_max) of byte;
end;

  
const
  
reset_dev  = 0;
auto       = 1;
repint     = 2;
startread  = 3;
  
small_top  = small_max + 1 ;
medium_top = medium_max + 1;
large_top  = large_max +  1;
min_data   = 3;
small_data = small_size div 2 + min_data;
medium_data= medium_size div 2+ min_data;
large_data = large_size div 2 + min_data;
max_data   = max_size div 2   + min_data;
  
priority   = priority_table(0,6,3,4,5);
  
var
w, result, result_modif : integer;
dev,msg,mw,m: reference;
s: stype;
resetmode: boolean:=true;
  
headpool: pool 1;
z : zone;

procedure readram(var w: byte;i: integer); external;
procedure writeram(i,w: integer); external;
procedure outwordclr(w: integer; var dev: reference); external;
procedure controlclr(w: integer; var dev: reference); external;
procedure control(w: integer; var dev: reference); external;
procedure inword(var w: integer; var dev: reference); external;
procedure sense(var s: stype; w: integer; var dev: reference); external;
  
procedure set_result(res, modif : integer);
var p1, p2 : integer;
begin
  p1 := priority(res);
  p2 := priority(result);
  if res = hard_error then resetmode := true;
  if p1 > p2 then
  begin
    result := res;
    result_modif := modif;
  end else
  if p1 = p2 then
  if modif > 0 then
  if (result_modif div modif) mod 2 = 0 then
      result_modif := result_modif + modif;
end (* procedure to set actual result of operation *) ;

procedure write(b: boolean);
var size, r : integer;
    data : boolean;
begin
w   := msg^.u3;
size:= msg^.size;
r   := ok_result;
while (size>0) and (r=ok_result) do 
begin
if size >= small_data then
begin
if size < medium_data then
lock msg as d: smallbuf do with d do 
begin
if b then next:=last+1;
if next>first then
if (first>=6) and (next<=small_top) then 
begin
outwordclr(w,dev); w:=c(next-1);
outbyteblock(next,first,next-2,msg,dev);
end else r:=unintelligible;
end else
if size < large_data then
lock msg as d: mediumbuf do with d do 
begin
if b then next:=last+1;
if next>first then
if (first>=6) and (next<=medium_top) then 
begin
outwordclr(w,dev); w:=c(next-1);
outbyteblock(next,first,next-2,msg,dev);
end else r:=unintelligible;
end else
if size <= max_data then
lock msg as d: largebuf do with d do 
begin
if b then next:=last+1;
if next>first then
if (first>=6) and (next<=large_top) then 
begin
outwordclr(w,dev); w:=c(next-1);
outbyteblock(next,first,next-2,msg,dev);
end else r:=unintelligible;
end else r := unintelligible;
end else r := unintelligible;
repeat pop(m,msg); data:=m^.size<>0; push(m,mw) until data;
if nil(msg) then size := 0 else size := msg^.size;
end;
while not nil(mw) do begin pop(m,mw); push(m,msg) end;
outwordclr(256+w,dev); controlclr(repint,dev);
if r <> ok_result then set_result(r,0);
end;

procedure read;
var size, r : integer;
    data : boolean;
begin
controlclr(startread,dev);  
if own.timer>0 then
begin
inword(w, dev); 
msg^.u3 := w mod 256;
size    := msg^.size;
r       := ok_result;
while (size>0) and (r=ok_result) do 
begin
if size >= small_data then
begin
if size < medium_data then
lock msg as d: smallbuf do with d do
if (last>=first) and not eoi then 
begin
if (first>=6) and (last<=small_max) then 
begin
controlclr(repint,dev); inbyteblock(next,first,last,msg,dev);
end;
end else next:=first else
if size < large_data then
lock msg as d: mediumbuf do with d do
if (last>=first) and not eoi then 
begin
if (first>=6) and (last<=medium_max) then 
begin
controlclr(repint,dev); inbyteblock(next,first,last,msg,dev);
end;
end else next:=first else
if size <= max_size then
lock msg as d: largebuf do with d do
if (last>=first) and not eoi then 
begin
if (first>=6) and (last<=large_max) then 
begin
controlclr(repint,dev); inbyteblock(next,first,last,msg,dev);
end;
end else next:=first else r := unintelligible;
end else r := unintelligible;
repeat pop(m,msg); data:=m^.size<>0; push(m,mw) until data;
if nil(msg) then size := 0 else size := msg^.size;
end;
if r<>ok_result then
begin
set_result(r,0);
end else
if not eoi then
begin
controlclr(repint,dev);
set_result(soft_error, blocklength_error);
end;
while not nil(mw) do begin pop(m,mw); push(m,msg) end;
end;
if own.timer=0 then set_result(soft_error, timeout);
end;
  
  
procedure status_test;
var switch : byte;
    r : integer;
begin
case s.stp of
2,3,6,7: set_result(hard_error, disconnected);
4,5: begin
readram(switch,10);
if switch>=128 then begin writeram(6,0); writeram(5,1); while true do end;
set_result(hard_error, autoload); s.stp:=s.stp-4; status_test;
end;
1: set_result(hard_error, reset);
0: begin
r := s.prty+2*s.ctmo;
if r <> 0 then
begin
  if r >= 2 then
  begin
    r := r - 2;
    set_result(soft_error, receiver_not_ready);
  end;
  if r = 1 then set_result(soft_error, parity);
end;
end;
end;
end (* procedure test of fpa-status *) ;

begin
testopen(z,own.incname,op);
  
result:=reservech(dev,level,-1);
if result<>0 then exception(4*16+result);
if rec then 
begin
alloc(msg,headpool,sem.w^);
with msg^ do begin u1:=timeransw; u3:=polltime; u4:=pollexp end;
sendtimer(msg);
end;
definetimer(true);

repeat
wait(msg,sem.w^); 
result := ok_result; result_modif := 0;
if resetmode then case msg^.u1 of
sensecom,resetcom,autocom: resetmode:=false;
timeransw: ;
otherwise set_result(rejected, 0);
end;
if not resetmode then 
begin
own.timer:=50;
case msg^.u1 of
sensecom: ;
readcom: channel dev do read;
writecom: channel dev do write(true);
writereadcom: channel dev do
              begin
                write(false);
                sense(s,0,dev); status_test;
                if result=ok_result
                   then read else set_result(result, combined_write);
              end;
resetcom: control(reset_dev,dev);
autocom: control(auto,dev);
timeransw: ;
otherwise set_result(unintelligible, bad_message);
end;
end;
sense(s,0,dev);
status_test;
with msg^ do if u1=timeransw then 
begin
u3:=polltime; u4:=pollexp; sendtimer(msg);
end else 
begin
u2:=result + result_modif; return(msg);
end
until false;
end
.
«eof»