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

⟦f351ac295⟧ TextFile

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

Derivation

└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦162d2eb5b⟧ »talgprog« 
            └─⟦this⟧ 

TextFile

(mode list.yes
device=set 25
device=algol connect.no
global device
device  dev.5.24
device printer
mode list.no)
1980-10-22
begin
integer i,j,k,nt,ntstart,ntarea,ntint,ntend,pda,na,
        dev,fdevice,ldevice;
boolean all,found;
integer array desc(1:1);
long array field n,name;
integer field kind,lowerb,upperb;
array inp(1:3);
long array search(1:2*200);

procedure list_proc(desc,pda,device);
value pda,device; integer pda,device;
integer array desc;
begin
  write(out,"nl",1);
  if device>=0 then write(out,<<dd>,device,<:::>) else
  write(out,"sp",3);
  write(out,<<dd>,desc.kind,"sp",2,true,12,desc.name,
        <<-dddddddd>,desc.lowerb,desc.upperb,<: ;:>,<<d>,pda);
end listproc;

readbfp(<:all:>,all,false);
lowerb:=2; upperb:=4; kind:=6;
name:=6;
ntstart:=wordload(74);
ntarea:=wordload(76);
ntint:=wordload(78);
ntend:=wordload(80);
connectlso;

if fpinareas>0 or all then
begin
  for na:=1 step 1 until fpinareas do
  begin
   n:=na*8-8;
   readinfp(inp,na);
   for i:=1,2 do search.n(i):=long inp(i);
  end inareas;
  for nt:=ntstart step 2 until ntend-2 do
  begin
    pda:=wordload(nt);
    redefarray(desc,pda-4,200);
    found:=all and desc.kind>=0 and desc.name(1) shift (-40) extract 8>96;
    na:=0;
    if -,all then
    repeat na:=na+1;
       n:=na*8-8;
       found:=search.n(1)=desc.name(1) and
              search.n(2)=desc.name(2) and desc.kind>=0;
     until found or na=fpinareas;
     if found then listproc(desc,pda,
         if nt>=ntarea then -1 else (nt-ntstart)//2);
  end cycle nt;
end fpinareas>0 or all;

if readifp(<:dev:>,fdevice,-1) then
begin
  ldevice:=fdevice;
  readifpnext(fpnr,ldevice);
  for dev:=fdevice step 1 until ldevice do
  begin
    nt:=ntstart+2*dev-2;
    pda:=wordload(nt);
    redefarray(desc,pda-4,200);
    if desc.name(1) shift (-40) extract 8 >96 and nt<ntarea then 
      listproc(desc,pda,dev);
  end dev;
end listdevices;
end;
▶EOF◀