|
|
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: »tdevice«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦162d2eb5b⟧ »talgprog«
└─⟦this⟧
(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◀