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

⟦cbc0f49dc⟧ TextFile

    Length: 7680 (0x1e00)
    Types: TextFile
    Names: »readporttx  «

Derivation

└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦this⟧ »readporttx  « 

TextFile

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◀