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

⟦a9d2c4192⟧ TextFile

    Length: 96768 (0x17a00)
    Types: TextFile
    Names: »ventatttx   «

Derivation

└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
    └─⟦a957ba283⟧ 
        └─⟦this⟧ »ventatttx   « 

TextFile

(
 message ventatt
 ventatt=set 1
 ventatt=algol ;message.no
;scope project ventatt
)
external
integer procedure ventatt(vent,z,i,ia,name,p);
boolean vent; zone z; integer i; integer array ia;
  long array name; boolean procedure p;
begin
  integer inres,res,gli;
  own boolean att,holdt; boolean stop,pause,start;

  gli:= i;
rep:
  i:= gli;
  res:= ventatt:= monitor(if vent or holdt then 24 else 66,z,i,ia);
  if res = 0 then
  begin comment message;
    if ia(1) = 0 then
    begin comment attention;
      boolean ud,op;
      long field l;
      long array field laf;
      long array po(1:2);
      integer array ia1(1:20),sv(1:9);
      zone zio(10,1,q);

      procedure q(z,s,b);
      zone z; integer s,b;
      begin
        if ud then else
        begin
          ud:= true;
          if s shift 7 < 0 <* attention *> then att:= true else
          if s shift 2 < 0 <* timer *> then
          begin
            setposition(zio,0,0);
            write(zio,"nl",1);
            close(zio,true)
          end
        end;
        goto rep
      end q;

      procedure r(b);
      boolean b;
      if -,p(b,ia1.laf) then
      begin
        setposition(zio,0,0);
        write(zio,<:<10>wait<10>:>);
        close(zio,true);
        if -,op then monitor(64) remove process :(zio,0,ia1)
      end r;

      name(1):=name(2):=0;
      ud:= true;
      getzone6(z,ia1);
      laf:= 2;
      monitor(26) get event :(z,i,ia);
      for res:= 1,2,3,4,5,6,7,8 do sv(res):= 0;
      sv(9):= 1;
      monitor(22) send answer :(z,i,sv);
      l:= 6;
      if ia.l = long <:stop:> then p(true,ia1.laf) else
      begin comment terminal;
        open(zio,8,ia1.laf,1 shift 21 + 1 shift 16);
        system(7,0,po);
        op:= ia1.laf(1) = po(1) and ia1.laf(2) = po(2);
        if op and -,att then
        begin comment console;
          write(zio,<:<10>STOP ? :>);
          setposition(zio,0,0);
          ud:= false;
          inres:=res:= inrec6(zio,0);
          inrec6(zio,res);
          if res >= 2 then
          begin comment >5 tegn læst;
<*---       if zio(1) shift (-16) shift 16 = real <:test:> then
            begin comment test;
              integer p,l,h,c,s,t;
              boolean plus;

              procedure gem;
              if s >= l and s <= h then test(s):= plus;

              p:= 5;
              res:= 3 * res // 2;
              t:= 1;
              l:= system(3,h,test);
              if l < 0 then l:= 0;
              if h >= l then
              while p <= res do
              begin
                getchar(zio,p,c);
                if c = 'nl' or c = 'sp' then
                begin
                  if t = 3 then goto svar;
                  if t = 4 then gem;
                  if c = 'nl' then goto svar;
                  t:= 2
                end 'nl' or 'sp' else
                if c = '+' or c = '-' then
                begin
                  if t = 3 then goto svar;
                  if t = 4 then gem;
                  plus:= c = '+';
                  t:= 3
                end '+' or '-' else
                if c >= '0' and c <= '9' then
                begin
                  if t <= 2 then plus:= true;
                  s:= c - '0' + (if t <= 3 then 0 else s * 10);
                  t:= 4
                end else goto svar
              end while;
svar:
              ud:= true;
              setposition(zio,0,0);
              write(zio,<:<10> Test:>);
              for res:= l step 1 until h do
              if test(res) then write(zio,<< dd>,res);
              write(zio,"nl",2);
              close(zio,true)
            end test else
            if zio(1) shift (-16) shift 16 = real <:stop:> then
---*>
            stop:=res>=4; pause:=start:=false;
            if stop then start:=zio(1) shift(-8) shift 8 = real <:start:>;
            if stop then pause:=zio(1) shift(-8) shift 8 = real <:pause:>;
            if stop then stop:=zio(1) shift(-16) shift 16 = real <:stop:>;
message CASE;
            if stop then
            begin comment stop;
              holdt:=false;
              ud:= true;
              r(false add 1)
            end stop
            else if pause then
            begin comment pause;
              holdt:= true;
            end pause
            else if start then
            begin comment start;
              holdt:= false;
            end start
            else if not holdt then
            begin
              integer array konv(0:255);
              integer p1, p2, k, t;
              isotable(konv);
              for k:=128 step 1 until 255 do konv(k):=6 shift 12 add k;
              p1:=p2:=1;
message NAVN;
              repeat
                k:=getchar(zio,p1,konv,t) shift(-12);
                if (k=6 or k=2) and t<128 then putchar(name,p2,t);
              until k>6 or t=0 or p2=12;
            end;
          end >5 tegn læst
        end console else
        begin
          att:= false;
          r(false)
        end;
        att:= false
      end terminal;
      goto rep
    end attention
  end message
end ventatt;
end
▶EOF◀