|
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◀