|
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: 6912 (0x1b00)
Types: TextFile
Names: »writeporttx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »writeporttx «
mode list.yes
writeport=algol rts.algftnrts7 survey.yes
begin
integer chars, sumchars, class, char, index, blockcount;
boolean return;
long reason;
zone zimc (128, 1, setcount), zarea (128, 1, stderror);
procedure setcount (z, s, b);
zone z ;
integer s, b ;
begin
imcsethdr (z, '0' + blockcount mod 10);
increase ( blockcount );
end;
sumchars := 0;
open (zimc, 0, <:ifpmain1:> , 0 );
return := ld__link (zimc, -1, <:fgsserver:> , 2, <::>, reason);
close (zimc, true);
if return then
begin
write (out,
"nl", 1, <:ld__link = true , maxsiz < 32 + buffs. = :>,
reason shift (-32), <: shift 32 + :>, reason shift (-24) extract 8,
"nl", 1, <: device index = :>,
reason extract 24);
open (zimc , 20, <:fgsserver:>, 1 shift 1);
open (zarea, 4, <:pop:>, 0);
return := imc_openport (zimc, 1, <:serverport:>, reason);
if return then
begin
index := 0;
return := imc_getconn (zimc , index, reason);
if return then
begin
trap (clean_up);
imcsetmode (zimc, 0, 0, 2);
blockcount := 1;
imcsethdr (zimc, '0' + blockcount mod 10);
for class := readchar (zarea, char) while char <> 'em' do
begin
outchar (zimc, char);
sumchars := sumchars + 1;
end;
outchar (zimc, 'em');
sumchars := sumchars + 1;
clean_up:
trap (0);
return := imc_disconn (zimc, reason);
write (out,
"nl", 1, <:disconn. = :>, if return then <:true:> else <:false:>,
"nl", 1, <:status = :>, reason shift (-36) extract 12,
"nl", 1, <:result = :>, reason shift (-24) extract 12,
"nl", 1, <:cstate = :>, reason shift (-12) extract 12,
"nl", 1, <:dc.rsn = :>, reason extract 12);
end imc_getconn
else
write (out,
"nl", 1, <:getconn. = false ::>,
"nl", 1, <:status = :>, reason shift (-36) extract 12,
"nl", 1, <:result = :>, reason shift (-24) extract 12,
"nl", 1, <:cstate = :>, reason shift (-12) extract 12,
"nl", 1, <:dc.rsn = :>, reason extract 12);
return := imc_closeprt (zimc, reason);
write (out,
"nl", 1, <:closeprt = :>, if return then <:true:> else <:false:>,
"nl", 1, <:status = :>, reason shift (-36) extract 12,
"nl", 1, <:result = :>, reason shift (-24) extract 12,
"nl", 1, <:pstate = :>, reason shift (-12) extract 12,
"nl", 1, <:cl.rsn = :>, reason extract 12);
end imc_openport
else
write (out,
"nl", 1, <:imc_openport = false ::>,
"nl", 1, <:status = :>, reason shift (-36) extract 12,
"nl", 1, <:result = :>, reason shift (-24) extract 12,
"nl", 1, <:pstate = :>, reason shift (-12) extract 12,
"nl", 1, <:cl.rsn = :>, reason extract 12);
close (zimc , true);
open (z_imc, 0, <:ifpmain1:> , 0 );
return := ld__unlink (z_imc, 0, <:fgsserver:> , reason);
close (z_imc, true );
write (out,
"nl", 1, <:ld__unlink = :>, if return then <:true:> else <:false:>,
<: result = :>, reason shift (-24) extract 12);
end else
write (out,
"nl", 1, <:ld__link = false, reason = :>, reason shift (-36) extract 12,
<: shift 36 + :>, reason shift (-24) extract 12, <: shift 24:>);
close (zarea, true);
write (out,
"nl", 1, <:chars xferred : :>, sumchars,
"nl", 1, <:segs xferred : :>, (sumchars + 767) // 768,
"nl", 1);
end;
▶EOF◀