DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »forgotten«

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

TextFile

process
fpadriver(var sem: semaphore; level, blocktime: integer; rec: boolean);
const
polltime =312; pollexp=5;  (* 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;
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
if last>=first then
if (first>=6) and (last<=255) then begin
outwordclr(w,dev); outbyteblock(next,first,last-1,msg,dev);
w:=c(last);
end else r:=4;

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

large: lock msg as d: largebuf do with d do
if last>=first then
if (first>=6) and (last<=2047) then begin
outwordclr(w,dev); outbyteblock(next,first,last-1,msg,dev);
w:=c(last);
end else r:=4;
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) and not eoi do begin
case sizeclass(size div 128) of
small: lock msg as d: smallbuf do with d do
if last>=first then
if (first>=6) and (last<=255) then begin
controlclr(repint,dev); inbyteblock(next,first,last,msg,dev);
end;

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

large: lock msg as d: largebuf do with d do
if last>=first then
if (first>=6) and (last<=2047) then begin
controlclr(repint,dev); inbyteblock(next,first,last,msg,dev);
end;
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;
end;


begin
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;
writereadcom: channel dev do begin write; 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);
case s.stp of
2,3,6,7: begin r:=3+8; resetmode:=true; end; (*disconected*)
end else begin
r:=r+8*s.prty+16*s.ctmo;
if r<>0 then r:=r+2;  (*softerror*)
end;
end;
msg^.u2:=r;  return(msg);
until false;
end;
.

▶EOF◀