|
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◀