DataMuseum.dk

top - metrics - download

    Length: 5376 (0x1500)
    Types: TextFileVerbose
    Names: »fpadriver«

└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
    └─⟦6b41451d2⟧ 
        └─⟦this⟧ »fpadriver« 

TextFileVerbose

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

sensecom    = 0;
resetcom    = 4;
autocom     = 8;
timeransw   = 5;
readcom     = 1;
writecom    = 2;
writereadcom= 3;

startread = 3;
repint    = 2;
reset     = 0;
auto      = 1;

type
stype=packed record
uu1: 0..1023;
ctmo,uu2: 0..1;
stp:0..7;
prty: 0..1;
end;

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

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

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

sizes=(too_small,small,medium,large);
sizetab= packed array (0..255) of sizes;

const
sizeclass=sizetab(too_small,3***small,4***medium,248***large);

var
b: boolean;
w,r: integer;
dev,msg,mw,m: reference;
s: stype;
resetmode: boolean:=true;
headpool: pool 1;

label stptest,modetest;

procedure readram(var w: integer;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 write(b: boolean);
begin with msg^ do begin
w:=u3;
while (size>0) and (r=0) do begin
case sizeclass(size div 128) of
small: lock msg as d: smallbuf do with d do begin
if b then next:=last;
if next>=first then
if (first>=6) and (next<=255) then begin
w:=c(next);
outwordclr(w,dev); outbyteblock(next,first,next-1,msg,dev);
end else r:=4;
end;

medium: lock msg as d: mediumbuf do with d do begin
if b then next:=last;
if next>=first then
if (first>=6) and (next<=1023) then begin
w:=c(next);
outwordclr(w,dev); outbyteblock(next,first,next-1,msg,dev);
end else r:=4;
end;

large: lock msg as d: largebuf do with d do begin
if b then next:=last;
if next>=first then
if (first>=6) and (next<=2047) then begin
w:=c(next);
outwordclr(w,dev); outbyteblock(next,first,next-1,msg,dev);
end else r:=4;
end;
otherwise r:=4;
end;
repeat pop(m,msg); b:=m^.size<>0; push(m,mw) until b;
end;
while not nil(mw) do begin pop(m,mw); push(m,msg) end;
if r=0 then begin outwordclr(256+w,dev); controlclr(repint,dev) end;
end;
end;

procedure read;
begin with msg^ do begin
controlclr(startread,dev); inword(w,dev); u3:=w;
while (size>0) and (r=0) do begin
case sizeclass(size div 128) of
small: lock msg as d: smallbuf do with d do
if (last>=first) and not eoi then begin
if (first>=6) and (last<=255) then begin
controlclr(repint,dev); inbyteblock(next,first,last,msg,dev);
end;
end else next:=first;

medium: lock msg as d: mediumbuf do with d do
if (last>=first) and not eoi then begin
if (first>=6) and (last<=1023) then begin
controlclr(repint,dev); inbyteblock(next,first,last,msg,dev);
end;
end else next:=first;

large: lock msg as d: largebuf do with d do
if (last>=first) and not eoi then begin
if (first>=6) and (last<=2047) then begin
controlclr(repint,dev); inbyteblock(next,first,last,msg,dev);
end;
end else next:=first;
otherwise r:=4;
end;
repeat pop(m,msg); b:=m^.size<>0; push(m,mw) until b;
end;
if not eoi and (r=0) then begin
controlclr(repint,dev);

(* blocklengtherror: two alternative actions *)
if not eoi then r:=32;
<*while not eoi do begin r:=32; controlclr(repint,dev) end;
*>
end;
end;
while not nil(mw) do begin pop(m,mw); push(m,msg) end;
end;


begin
r:=reservech(dev,0,level,-1);
if r<>1 then exception(4*16+r);
if rec then begin
alloc(msg,headpool,sem);
with msg^ do begin u1:=timeransw; u3:=polltime; u4:=pollexp end;
sendtimer(msg);
end;

repeat
wait(msg,sem); r:=0;
if resetmode then case msg^.u1 of
sensecom,resetcom,autocom: resetmode:=false;
timeransw: ;
otherwise r:=1;
end;
if not resetmode then begin
own.timer:=blocktime;
case msg^.u1 of
sensecom: ;
readcom: channel dev do read;
writecom: channel dev do write(true);
writereadcom: channel dev do begin write(false); read end;
resetcom: control(reset,dev);
autocom: control(auto,dev);
timeransw: ;
otherwise r:=4;
end;
end;

if (r mod 8 < 4) and (r<>1) then begin
sense(s,0,dev);
stptest:
case s.stp of
2,3,6,7: begin r:=3+8; resetmode:=true; end; (*disconected*)
4,5:     begin (* autoload *)
readram(r,10);
if r>=256 then begin writeram(6,0); writeram(5,1); while true do end;
r:=128; s.stp:=s.stp-4; goto stptest;
end;
1:       begin r:=3+16; resetmode:=true; end; (* reset *)
0:       begin r:=r+8*s.prty+16*s.ctmo; if r<>0 then r:=r+2; end;
end;
end;
with msg^ do if u1=timeransw then begin
u3:=polltime; u4:=pollexp; sendtimer(msg);
end else begin
u2:=r; return(msg);
end
until false;
end;
.

«eof»