|
|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 2304 (0x900)
Types: TextFile
Names: »ttestbit«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »ttestbit«
external
boolean procedure testbit(bit); integer bit;
begin own boolean initialized; own long pattern;
if -,initialized then
begin comment read call parameters;
boolean not; boolean array byte(0:3);
integer sep,spacename,pointinteger,fpno,i,param;
array fpparam(1:2);
procedure alarm;
begin integer i; i:=1;
write(out,<:<10>testbit parameter: :>);
if sep=pointinteger then write(out,<<d>,param)
else write(out,string fpparam(increase(i)));
write(out,<: ignored<10>:>);
end alarm;
byte(0):=byte(1):=byte(2):=byte(3):=false;
spacename:=4 shift 12 + 10;
pointinteger:=8 shift 12+4;
fpno:=0; sep:=system(4,fpno,fpparam);
for fpno:=fpno+1 while sep<>0 do
begin
sep:=system(4,fpno,fpparam);
if sep=spacename then
begin
if fpparam(1)=real<:testb:> add 105
and fpparam(2)=real<:t:> then
begin
not:=false;
fpno:=fpno+1;
sep:=system(4,fpno,fpparam);
for fpno:=fpno+1 while sep shift (-12)=8 do
begin
if sep=pointinteger then
begin
param:=fpparam(1); i:=param//12;
if param>47 then alarm else
begin
param:=1 shift (param mod 12);
if not then
byte(i):=byte(i) and -,(false add param)
else
byte(i):=byte(i) or (false add param)
end
end
else
if fpparam(1)=real<:all:> then
byte(0):=byte(1):=byte(2):=byte(3):=true
else if fpparam(1)=real<:not:> then not:=true
else alarm;
sep:=system(4,fpno,fpparam);
end points;
if sep=spacename then fpno:=fpno-2;
end testbit
end spacename
end loop parambit;
pattern:=pattern shift 12 add (byte(3) extract 12) shift 12
add (byte(2) extract 12) shift 12 add (byte(1)
extract 12) shift 12 add (byte(0) extract 12);
initialized:=true
end initialize;
testbit:=false add ((pattern shift (-bit)) extract 12);
end testbit;
end
▶EOF◀