|
|
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: »tfppr«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »tfppr«
<*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◀