|
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: 7680 (0x1e00)
Types: TextFile
Names: »readporttx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »readporttx «
mode list.yes
readport=algol rts.algftnrts7 survey.yes
begin
integer chars , sumchars, class , char, index;
boolean return;
long reason;
zone z_imc (128, 1, report), zarea (128, 1, stderror);
procedure report (z, s, b);
zone z ;
integer s, b ;
begin
<******************************************>
<* the purpose of the procedure is to get *>
<* - the character count of the zone *>
<* - the header character of the block *>
<* - the imcstate of the connection *>
<* after every blockchange in the zone *>
<******************************************>
own
integer blockcount;
integer blockheader, charcount, state, reason;
increase (blockcount);
charcount := imcgetchcnt (z_imc );
blockheader := imcgethdr (z_imc );
state := imcgetstate (z_imc, reason);
write (out,
"nl", 2, <:after blockchange no : :>, blockcount ,
"nl", 1, <:character count : :>, charcount ,
"nl", 1, <:blockheader : :>, blockheader,
"nl", 1, <:state : :>, state ,
"nl", 1, <:reason : :>, reason );
end report;
sumchars := 0;
open (zimc, 0, <:ifpmain1:>, 0 );
return := ld__link (zimc, -1, <:fgsuser:> , 2, <::>, reason);
close (zimc, true);
if return then
begin
write (out,
"nl", 1, <:ld__link = true , buffs. < 32 + maxch shift 24 = :>,
reason shift (-32), <:shift 32 + :>, reason shift (-24) extract 8,
"nl", 1, "sp", 18, <:dev index = :>,
reason extract 24);
open (z_imc, 20, <:fgsuser:>, 1 shift 1);
open (zarea, 4, <:pip:>, 0);
return := imc_openport (z_imc, 1, <:userport:>, reason);
if return then
begin
index := 0;
return := imc_connect (z_imc , index, <:serverport:>, reason);
if return then
begin
trap (clean_up);
imcsetmode (z_imc, 0, 0, 2);
for class := readchar (z_imc, char) while char <> 'em' do
begin
outchar (zarea, char);
sumchars := sumchars + 1;
end;
outchar (zarea, 'em');
sumchars := sumchars + 1;
clean_up:
trap (0);
return := imc_disconn (z_imc, reason);
write (out,
"nl", 1, <:imc_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_connect
else
write (out,
"nl", 1, <:imc_connect = 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 (z_imc, reason);
write (out,
"nl", 1, <:imccloseprt = :>, 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 (z_imc, true);
open (z_imc, 0, <:ifpmain1:>, 0 );
return := ld__unlink (z_imc, 0, <:fgsuser:> , 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◀