DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

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

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦26e553daa⟧ TextFile

    Length: 2304 (0x900)
    Types: TextFile
    Names: »ttestbit«

Derivation

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »ttestbit« 

TextFile

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◀