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

⟦7c7f7c17b⟧ TextFile

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

Derivation

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦e4d872f9f⟧ »cproc« 
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦e4d872f9f⟧ »cproc« 
            └─⟦this⟧ 

TextFile

mode listing.yes list.yes
printfile=algol
1980-10-23
external
integer procedure printfile(printer,file);
string printer,file;
begin
integer result,pda,i,trnr;
own boolean test;
real ers;
array field r;
long array field trans,sender,receiver,user;
integer array c(1:30),an(1:11);
integer array tail(1:10);
array name(1:3);

ers:=real <:<10>** printfile :>;
trnr:=-1;
cleararray(name);
movestring(name,1,file);
result:=lookuptail(name,tail);
if result>0 or tail(1)<=0 or tail(9)>0 then
begin
   i:=1;
  write(out,string ers,string name(increase(i)),
    <: entry:>);
  if result=0 then 
  begin
   if tail(1)<0 then write(out,<: size:>,tail(1)) else
      write(out,<: content:>,tail(9));
  end else
    write(out,<: lookup result :>,result);
if result=0 then result:=if tail(1)<0 then 7 else 8;
result:=32+result;
end area improper
else
begin
user:=16;
sender:=40;
receiver:=50;
r:=0;
cleararray(c);
for i:=7,8,13 step 1 until 20,25,30 do c(i):=-1;
pda:=wordload(66);
for i:=1,2 do c.user(i):=doubleload(pda+4*i);
for i:=1,2 do c.sender(i):=long name(i);
movestring(c.receiver.r,1,printer);
if c.receiver(1)=long <::> then movestring(c.receiver.r,1,<:lp:>);
i:=0;
if test then
begin
repeat i:=i+1;
  write(out,c(i),"nl",if i mod 5=1 then 1 else 0);
until i=30
end
else
result:=transfer(2,c,30,an,11);
if test then else
if result>0 then
  write(out,string ers,true,12,c.sender,"sp",1,
     case result-1 of (<:primo rejected:>,
     <:primo unintelligible:>,<:primo malfunction:>,
     <:primo does not exist:>,<:buffer claim exceeded:>,
     <:illegal parameter:>,<:parameter error:>,
     <:criterion error:>))
else
if result=0 and an(1)=0 then
begin
  trnr:=an(2);
  write(out,"nl",1,true,12,c.sender,<: transport :>,<<ddd>,an(2))
end
else
begin
result:=an(1)+16;
write(out,string ers,true,12,c.sender,"sp",1,case an(1)-1 of
     (<:transport unknown:>,<:missing resources:>,
      <::>,<:file trouble:>,<:printer trouble:>));
if an(1)=6 then write(out,"sp",1,true,12,c.receiver);
if an(1)>4 then
begin
  i:=case an(1)-4 of (8,10);
  i:=an(i);
  write(out,case i of (<: entry troubles:>,<: device troubles:>));
end receiver sender troubles
end troubles;
end entry exist;
printfile:=if trnr>0 then trnr else -result;
end;
end
mode 15.no list.no
▶EOF◀