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

⟦215d40457⟧ TextFile

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

Derivation

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »tfppr« 

TextFile

<*fp-procedures using the external procedure fpproc
1982.04.14
Anders Lindgård
*>
long array out_stack_inf(1:2);
integer in_stacked,out_stacked;

procedure finis;
begin
  fpproc(14,0,0,0);
end;

procedure in_block(z);
zone z;
begin
   fpproc(22,0,z,0);
end;

procedure out_block(z);
zone z;
begin
  fpproc(23,0,z,0);
end;

integer procedure in_char(z);
zone z;
begin
integer char;
  fpproc(25,0,z,char);
  inchar:=char;
end;

procedure out_char(z,char);
value char; integer char;
zone z;
begin
  fpproc(26,0,z,char);
end;

integer procedure connect_in_z(z,name);
long array name; zone z;
begin
integer res;
  fpproc(27,res,z,name);
  connect_in_z:=res;
end;

integer procedure connectcuri(name);
long array name;
begin
integer res;
   fpproc(29,0,in,0); <*stack current input*>
   fpproc(27,res,0,name); <*connect current input*>
   if res=0 then instacked:=instacked+1 else
      unstackcuri;
connectcuri:=res;
end;

integer procedure connectcuro(name);
long array name;
begin
  integer res;
  fpproc(29,0,out,outstackinf); <*stack curren output*>
  fpproc(28,res,0,name); <*connect current out*>
  if res=0 then outstacked:=outstacked+1 else
  unstackcuro;
end;

procedure unstackcuri;
begin
   fpproc(30,0,in,0);
   instacked:=instacked-1;
end;

procedure unstackcuro;
begin
   fpproc(30,0,out,outstackinf);
   outstacked:=outstacked+1;
end;

procedure outend(z,char);
value char; integer char;
zone z;
begin
  fpproc(33,0,z,char);
end;

procedure outend_cur(char);
value char; integer char;
begin
  fpproc(33,0,out,char);
end;

procedure closeout;
begin
  fpproc(34,0,out,0);
  fpproc(79,0,out,0); <*terminate*>
  unstackcuro;
end;

procedure parent_message(mess);
integer array mess;
begin
  zone z(1,1,stderror);
  long array field n;
  n:=8;
  open(z,0,mess.n,0);
  fpproc(35,0,mess,z);
  close(z,true);
end;
▶EOF◀