⟦4c71f7b45⟧

TextFile

kermit=algol
begin 
  integer i, p, mk, state, breakstate, retrycount, retry_limit,
     incount,  inseq,  inpackettype,  checksum, crc,
     outcount, outseq, outpackettype, indatacount, outdatacount,
     packetsize, timeout, numpad, padchar, endchar, startchar,
     cntrlquote, bit8quote, checktype, repchar, max_packetsize, ext_packetsize,
     state_ri, state_rf, state_rd, state_si, state_sf, state_sd,
     state_sz, state_sb, state_c, state_a, state_t;
  boolean attr_pkt, windowing, ext_length;
  boolean running, binary;
  integer array tail(1:10), 
    alfa(0:255), saveattr(1:8), shd(1:12);
  real array recvdata, senddata, msgtext(1:350), filename(1:2);
  long array primary_device(1:2);
  integer array field iaf;
  long array field laf;
  real array field raf;

  procedure init_kermit;
  begin
    integer i;

    i:= 1;
    state_ri   := increase(i);
    state_rf   := increase(i);
    state_rd   := increase(i);
    state_si   := increase(i);
    state_sf   := increase(i);
    state_sd   := increase(i);
    state_sz   := increase(i);
    state_sb   := increase(i);
    state_c    := increase(i);
    state_a    := increase(i);
    state_t    := increase(i);

    retry_limit := 2;
    max_packetsize:= 63;
    ext_packetsize:=packetsize:= 2000;
    timeout     := 60;
    numpad      := 0;
    padchar     := 0;
    endchar     := 'cr';
    startchar   := 'soh';
    cntrlquote  := '#';
    bit8quote   := '&';
    checktype   := '1';
    repchar     := 'ü';
    attr_pkt    := false;
    windowing   := false;
    ext_length  := true;

    <* default settings *>
    running     := true;
  end;

  integer procedure tochar(x);
    value x; integer x;
  begin
    tochar:= x+' ';
  end;

  integer procedure unchar(x);
    value x; integer x;
  begin
    unchar:= x-' ';
  end;

  integer procedure ctrl(x);
    value x; integer x;
  begin
    ctrl:= (if (x>='@'and x<='_') or x='del' then (x-'@') 
            else if x<' ' or x='?' then (x+'@') else x);
  end;

  integer procedure unshift(x);
    value x; integer x;
  begin
    unshift:= (if 'A'<= x and x<='Å' then (x-'A'+'a') else x);
  end;

  procedure crc_check(c);
    value c; integer c;
  begin
    integer q;

    c:= c extract 7;
    q:= exor(crc,c) extract 4;
    crc:= exor(crc shift (-4),q * 4225);
    q:= exor(crc,c shift (-4)) extract 4;
    crc:= exor(crc shift (-4),q * 4225);
  end;

  procedure timer(z,s,b);
    zone z; integer s,b;
  begin
    if (s extract 1) = 1 then stderror(z,s,b)
    else
    begin
      if (s shift (-16) extract 1) = 1 then running:= false;
      z(1):= real<:<'em'>:>;
      b:= 2;
    end;
  end;

  zone zin(350,1,timer), zout(350,1,stderror), zf, zl, zh(128,1,stderror);

  boolean procedure readch(c);
   integer                 c;
  begin
    readchar(zin,c);
    readch:= c<>'em';
  end;

  procedure printchar(z,c);
    zone z; integer c;
  begin
    if c<' ' or c='del' then write(z,"^",1,false add ctrl(c),1)
    else outchar(z,c);
  end;\f

message kermit - packet procedures, page 1;

  <*********************>
  <* packet procedures *>
  <*********************>

  procedure send_packet;
  begin
    integer i, sum, checkbytes, achar, ochar;

    achar:= 0;
    setposition(zin,0,0); <* throw away all previous incomming data *>
    sum:= crc:= 0;
    checkbytes:= 1;

if testbit(0) then write(zl,<:S(:>,<<d>,state,<:): :>);
    
    if (outpackettype='S') or (outpackettype='I') or
       ( inpackettype='S') or ( inpackettype='I') or
       ( inpackettype='R')
    then <* leave checkbytes = 1 *>
    else
    if checktype='2' then checkbytes:= 2 else
    if checktype='3' then checkbytes:= 3 ;
<*  write(zout,false add (startchar+0*128),1); *>
    outchar(zout,startchar);                          <* SOH *>
if testbit(0) then printchar(zl,startchar);

    outcount:= outdatacount + 2 + checkbytes;
    if outcount > max_packetsize and ext_length then
      outcount:= 0;

    ochar:= tochar(outcount);                         <* COUNT *>
    outchar(zout,ochar);
    sum:= sum+ochar; crc_check(ochar);
if testbit(0) then outchar(zl,ochar);
    ochar:= tochar(outseq);                           <* SEQ *>
    outchar(zout,ochar);
    sum:= sum+ochar; crc_check(ochar);
if testbit(0) then outchar(zl,ochar);
    ochar:= outpackettype;                            <* TYPE *>
    outchar(zout,ochar);
    sum:= sum+ochar; crc_check(ochar);
if testbit(0) then outchar(zl,ochar);
    if outcount=0 and ext_length then
    begin
      ochar:= tochar( (outdatacount+checkbytes)//95 ); <* LENX1 *>
      outchar(zout,ochar);
      sum:= sum+ochar; crc_check(ochar);
if testbit(0) then outchar(zl,ochar);
      ochar:= tochar( (outdatacount+checkbytes) mod 95 ); <* LENX2 *>
      outchar(zout,ochar);
      sum:= sum+ochar; crc_check(ochar);
if testbit(0) then outchar(zl,ochar);
      checksum:= (sum + (sum shift (-6) extract 2)) extract 6;
      ochar:= tochar(checksum);                        <* HCHECK *>
      outchar(zout,ochar);
      sum:= sum+ochar; crc_check(ochar);
if testbit(0) then outchar(zl,ochar);
    end;

    if outdatacount > 0 then
      for i:= 1 step 1 until outdatacount do
      begin
        getchar(senddata,i+0,ochar);                   <* DATA *> 
        outchar(zout,ochar);
        sum:= sum+ochar; crc_check(ochar);
if testbit(0) then outchar(zl,ochar);
      end;
    
    if checkbytes = 1 then
    begin
      checksum:= (sum + (sum shift (-6) extract 2)) extract 6;
      ochar:= tochar(checksum);
      outchar(zout,ochar);
if testbit(0) then outchar(zl,ochar);
    end
    else
    if checkbytes = 2 then
    begin
      checksum:= sum shift (-6) extract 6;
      ochar:= tochar(checksum);
      outchar(zout,ochar);
if testbit(0) then outchar(zl,ochar);
      checksum:= sum extract 6;
      ochar:= tochar(checksum);
      outchar(zout,ochar);
if testbit(0) then outchar(zl,ochar);
    end
    else
    if checkbytes = 3 then
    begin
      outchar(zout,tochar(crc shift (-12) extract 4));
      outchar(zout,tochar(crc shift (-6) extract 6));
      outchar(zout,tochar(crc extract 6));
if testbit(0) then outchar(zl,tochar(crc shift (-12) extract 4));
if testbit(0) then outchar(zl,tochar(crc shift (-6) extract 6));
if testbit(0) then outchar(zl,tochar(crc extract 6));
    end;

    outchar(zout,endchar);
<*  write(zout,false add (endchar+0*128),1);  *>
if testbit(0) then outchar(zl,'nl');
    if numpad > 0 then
      for i:= 1 step 1 until numpad do outchar(zout,padchar);

    setposition(zout,0,0);
  end; <* procedure send_packet *> 

  boolean procedure recv_packet;
  begin
    integer i, sum, inchar, checkbytes;
    boolean extended;
    
    recvpacket:= false;
    inchar:= ' ';

if testbit(0) then write(zl,<:R(:>,<<d>,state,<:): :>);
    while inchar<>startchar do                 <* SOH *>
    begin
      if -, readch(inchar) then goto exit;
if testbit(0) then printchar(zl,inchar);
    end;

    sum:= crc:= 0;

    if -, readch(inchar) then goto exit;      <* COUNT *>
if testbit(0) then outchar(zl,inchar);
    sum:= sum+inchar;
    crc_check(inchar);
    incount:= unchar(inchar);
    extended:= incount=0;

    if -, readch(inchar) then goto exit;      <* SEQ *>
if testbit(0) then outchar(zl,inchar);
    sum:= sum+inchar;
    crc_check(inchar);
    inseq:= unchar(inchar);

    if -, readch(inchar) then goto exit;      <* TYPE *>
if testbit(0) then outchar(zl,inchar);
    sum:= sum+inchar;
    crc_check(inchar);
    inpackettype:= inchar;
    checkbytes:= 1;
    if (outpackettype='S') or
       ( inpackettype='S') or
       ( inpackettype='I') or
       ( inpackettype='R')
    then
    else
    if checktype='2' then checkbytes:= 2 else
    if checktype='3' then checkbytes:= 3 ;

    if extended then
    begin
      if -, readch(inchar) then goto exit;      <* LENX1 *>
if testbit(0) then outchar(zl,inchar);
      sum:= sum+inchar;
      crc_check(inchar);
      incount:= unchar(inchar);
      if -, readch(inchar) then goto exit;      <* LENX2 *>
if testbit(0) then outchar(zl,inchar);
      sum:= sum+inchar;
      crc_check(inchar);
      incount:= incount*95 + unchar(inchar) + 2;
      checksum:= (sum + (sum shift (-6) extract 2)) extract 6;
      if -,readch(inchar) then goto exit;      <* HCHECK *>
      sum:= sum+inchar;
      crc_check(inchar);
      if inchar<>tochar(checksum) then
      begin
if testbit(0) then write(zl,<: bad headerchecksum ; expected/read :>,
                            false add tochar(checksum),1,"/",1);
if testbit(0) then printchar(zl,inchar);
        recv_packet:= false;
        goto exit;
      end 
      else
if testbit(0) then printchar(zl,inchar);
    end;

    indatacount:= incount - 2 - checkbytes;
    if indatacount > 0 then
      for i:= 1 step 1 until indatacount do
      begin
        if -, readch(inchar) then goto exit;      <* DATA *>
if testbit(0) then outchar(zl,inchar);
        sum:= sum+inchar;
        crc_check(inchar);
        putchar(recvdata,i+0,inchar);
      end;

    recv_packet:= true;

    if checkbytes = 1 then
    begin
      checksum:= (sum + (sum shift (-6) extract 2)) extract 6;
      if -,readch(inchar) then recv_packet:= false
      else if inchar<>tochar(checksum) then
      begin
if testbit(0) then write(zl,<: bad checksum ; expected/read :>,
                            false add tochar(checksum),1,"/",1);
        recv_packet:= false;
      end;
if testbit(0) then printchar(zl,inchar);
    end
    else
    if checkbytes = 2 then
    begin
      checksum:= sum shift (-6) extract 6;
      if -,readch(inchar) then 
      else if inchar<>tochar(checksum) then recv_packet:= false;
if testbit(0) then outchar(zl,inchar);
      checksum:= sum extract 6;
      if -,readch(inchar) then
      else if inchar<>tochar(checksum) then recv_packet:= false;
if testbit(0) then outchar(zl,inchar);
    end
    else
    if checkbytes = 3 then
    begin
      checksum:= crc shift (-12) extract 4;
      if -,readch(inchar) then
      else if inchar<>tochar(checksum) then recv_packet:= false;
if testbit(0) then outchar(zl,inchar);
      checksum:= crc shift (-6) extract 6;
      if -,readch(inchar) then
      else if inchar<>tochar(checksum) then recv_packet:= false;
if testbit(0) then outchar(zl,inchar);
      checksum:= crc extract 6;
      if -,readch(inchar) then
      else if inchar<>tochar(checksum) then recv_packet:= false;
if testbit(0) then outchar(zl,inchar);
    end;
  exit:
    if -,running then
    begin
      write(out,<:Kermit afbrudt med attention<10>:>);
if testbit(0) then write(zl,<: <ATT>:>);
    end;
if testbit(0) then outchar(zl,'nl');
  end; <* procedure recv_packet *>

  procedure decode_file(z);
    zone z;
  begin
   integer pos, ch, repcount, bit8;

    pos:= 1;
    while pos <= indatacount do
    begin
      getchar(recvdata,pos,ch);

      if ch=repchar then
      begin
        getchar(recvdata,pos,ch);
        repcount:= unchar(ch);
        getchar(recvdata,pos,ch);
      end
      else
        repcount:= 1;

      if ch=bit8quote then
      begin
        bit8:= 128;
        getchar(recvdata,pos,ch);
      end
      else
        bit8:= 0;
      
      if ch=cntrlquote then
      begin
        getchar(recvdata,pos,ch);
        ch:= ctrl(ch);
      end;

      ch:= (ch mod 128) + bit8;

      for i:= 1 step 1 until repcount do
        if ch<>'cr' then outchar(z,ch);
    end;
  end; <* procedure decode_file *>

  integer procedure decode_data(buf);
    real array buf;
  begin
   integer pos, p, ch, repcount, bit8;

    pos:= 1;
    p:=1;
    while pos <= indatacount do
    begin
      getchar(recvdata,pos,ch);

      if ch=repchar then
      begin
        getchar(recvdata,pos,ch);
        repcount:= unchar(ch);
        getchar(recvdata,pos,ch);
      end
      else
        repcount:= 1;

      if ch=bit8quote then
      begin
        bit8:= 128;
        getchar(recvdata,pos,ch);
      end
      else
        bit8:= 0;
      
      if ch=cntrlquote then
      begin
        getchar(recvdata,pos,ch);
        ch:= ctrl(ch);
      end;

      ch:= (ch mod 128) + bit8;

      for i:= 1 step 1 until repcount do
        putchar(buf,p,ch);
    end;

    decode_data:= p-1;
    repeat putchar(buf,p,0) until (p mod 6)=1;
  end; <* procedure decode_data *>

  procedure decode_filename(name);
    real array name;
  begin
    real array buf(1:32);
    integer p,pos,ch,i;

    p:=pos:=1;
    decode_data(buf);
    while getchar(buf,pos,ch)<>0 do
    begin
      ch:=unshift(ch);
      if ch<>'.' and p<12 then
      begin
        if ('a'<=ch and ch<='å') or ('0'<=ch and ch<='9') then
          putchar(name,p,ch)
        else
          putchar(name,p,'ø');
      end;
    end;
    while p<13 do putchar(name,p,0);
  end;

  procedure encode_data(buf);
    real array buf;
  begin
    integer i, pos, p, ch;

    pos:= 1; p:=1;
    while ((p-1)<packetsize-3-4) and (getchar(buf,pos,ch) extract 12 <> 0) do
    begin
      if ch >= 128 then
        putchar(senddata,p,bit8quote);
      ch:= ch mod 128;
      if ch<' ' or ch='del' then
      begin
        putchar(senddata,p,cntrlquote);
        putchar(senddata,p,ctrl(ch));
      end
      else
      if ch=bit8quote or ch=cntrlquote or ch=repchar then
      begin
        putchar(senddata,p,cntrlquote);
        putchar(senddata,p,ch);
      end
      else
        putchar(senddata,p,ch);                  
    end;
    outdatacount:= p-1;
  end; <* procedure encode_data *>

  procedure encode_filename(name);
    real array name;
  begin
    real array buf(1:8);
    integer p,pos,ch,i;

    p:=pos:=1;
    while getchar(name,pos,ch)<>0 do
    begin
      ch:= (if ('A' <= ch and ch <= 'Å') or ('0' <= ch and ch <= '9')
            then ch else if 'a'<=ch and ch<='z' then (ch-'a'+'A') else '$');
      if p=9 then putchar(buf,p,'.');
      if p<=12 then putchar(buf,p,ch);
    end;
    repeat putchar(buf,p,0); until (p mod 6)=1;
    encode_data(buf);
  end;

  integer procedure encode_file(z);
    zone z;
  begin
    integer p, ch;

    p:=1; readchar(z,ch);
    while ((p-1)<packetsize-4-4) and (ch<>'em') do
    begin
      if ch >= 128 then
        putchar(senddata,p,bit8quote);
      ch:= ch mod 128;
      if ch<' ' or ch='del' then
      begin
        if ch='nl' then
        begin
          putchar(senddata,p,cntrlquote);
          putchar(senddata,p,ctrl('cr'));
        end;
        putchar(senddata,p,cntrlquote);
        putchar(senddata,p,ctrl(ch));
      end
      else
      if ch=bit8quote or ch=cntrlquote or ch=repchar then
      begin
        putchar(senddata,p,cntrlquote);
        putchar(senddata,p,ch);
      end
      else
        putchar(senddata,p,ch);
      readchar(z,ch);
    end;
    repeatchar(z);
    encode_file:= outdatacount:= p-1;
  end; <* procedure encode_file *>

  boolean procedure retry;
  begin
    integer p;

    retry:= true;
    increase(retry_count);
    if retry_count > retry_limit then
    begin
      p:=1;
      movestring(msgtext,p,<:Retrylimit exeeded:>);
      send_msg_packet('E',msgtext,outseq);
      retry:= false;
    end;
  end; <*procedure retry*>

  procedure send_packettype(packettype,seq);
    value packettype; integer packettype, seq;
  begin
    integer saveseq;

    <* send Ack or Nak or B or Z *>
    saveseq:= outseq;
    outseq:= seq;
    outdatacount:= 0;
    outpackettype:= packettype;
    sendpacket;
    outseq:= saveseq;
  end; <* procedure send_packettype *>

  procedure send_msg_packet(packettype,msg,seq);
    value packettype, seq; integer packettype, seq;
    real array msg;
  begin
    outpackettype:= packettype;
    outseq:= seq;
    encode_data(msg);
    sendpacket;
  end; <* procedure send_msg_packet *>

  procedure putinitpacket;
  begin
    <* put parameters into initpacket *>
    integer attr, mask;

    outdatacount:= 13;
    outseq:= 0;
    putchar(senddata,1,tochar((if packetsize > max_packetsize then
      max_packetsize else packetsize)));
    putchar(senddata,2,tochar(timeout));
    putchar(senddata,3,tochar(numpad));
    putchar(senddata,4,tochar(padchar));
    putchar(senddata,5,tochar(endchar));
    putchar(senddata,6,cntrlquote);
    putchar(senddata,7,bit8quote);
    putchar(senddata,8,checktype);
    putchar(senddata,9,repchar);
    mask:= 0;
<*  if attr_pkt then mask:= mask + 8;
    if windowing then mask:= mask + 4;
*>  if ext_length then mask:= mask + 2;
    putchar(senddata,10,tochar(mask));
    putchar(senddata,11,tochar(0)); <*windowsize*>
    putchar(senddata,12,tochar(ext_packetsize//95));
    putchar(senddata,13,tochar(ext_packetsize mod 95));
  end; <* procedure putinitpacket *>

  procedure getinitpacket;
  begin <* get init parameters *>
    integer ch, mask;

    if indatacount >=1 then getchar(recvdata,1,ch); packetsize:= unchar(ch);
    if indatacount >=2 then getchar(recvdata,2,ch); timeout:= unchar(ch);
    if indatacount >=3 then getchar(recvdata,3,ch); numpad:= unchar(ch);
    if indatacount >=4 then getchar(recvdata,4,ch); padchar:= unchar(ch);
    if indatacount >=5 then getchar(recvdata,5,ch); endchar:= unchar(ch);
    if indatacount >=6 then getchar(recvdata,6,cntrlquote);
    if indatacount >=7 then
    begin
      getchar(recvdata,7,bit8quote);
      if bit8quote='Y' then bit8quote:= '&';
      if (bit8quote < '!') or ('ü' < bit8quote) or
         ('?' < bit8quote and bit8quote < '`') then bit8quote:= 0;
    end
    else bit8quote:= 0;
    if indatacount >=8 then
    begin
      getchar(recvdata,8,checktype);
      if -,('1' <= checktype and checktype <= '3') then checktype:= '1';
    end
    else checktype:= '1';
    if indatacount >=9 then
    begin
      getchar(recvdata,9,repchar);
      if (repchar < '!') or ('ü' < repchar) or
         ('?' < repchar and repchar < '`') then repchar:= 0;
    end
    else repchar:= 0;
    if indatacount >=10 then
    begin
      getchar(recvdata,10,ch); mask:=  unchar(ch);
    end
    else mask:= 0;
    if indatacount < 13 then
      ext_packetsize:= 0
    else
    begin
      getchar(recvdata,12,ch); ext_packetsize:= unchar(ch);
      getchar(recvdata,13,ch); 
      ext_packetsize:= ext_packetsize*95 + unchar(ch);
    end;
    attr_pkt:= windowing:= false;
    ext_length:= false add (mask shift (-1) extract 1);
    if -, ext_length then ext_packetsize:= 0
    else if ext_packetsize=0 then ext_packetsize:= 500;
    if ext_length then packetsize:= ext_packetsize;
  end; <* procedure getinitpacket *>

  <*---------------  end of packet procedures  ---------------*>\f

message kermit - main body, page 1;

  <**************** start of main program body ****************>

if testbit(0) then
  open(zl,4,<:kermitlog:>,0);

  raf:=laf:=iaf:= 0;       
  for i:= 0 step 1 until 255 do alfa(i):= 6 shift 12 + i;
  alfa(0):= 0;
  for i:= 10,13,25 do
    alfa(i):= 8 shift 12 + i;
  system(7,mk,primary_device);
  open(zin,mk,primary_device,1 shift 21 + 1 shift 16);
  open(zout,mk,primary_device,0);
  intable(alfa);

  <* lookup termial attributes *>
  open(zh,0,primary_device,0);
  getshare6(zh,shd,1);
  shd(1):= 1;
  shd(4):= 134 shift 12;
  for i:= 5 step 1 until 11 do shd(i):= 0;
  setshare6(zh,shd,1);
  monitor(16)send_message:(zh,1,shd);
  monitor(18)wait_answer:(zh,1,saveattr);

  trap(exit);

  <* set timeoutvalue and echo off *>
  getshare6(zh,shd,1);
  shd(1):= 1;
  shd(4):= 132 shift 12;
  for i:= 5 step 1 until 11 do shd(i):= saveattr(i-3);
  shd(5):= 3;
  shd(7):= 0;
  shd(10):= 10 shift 8;
  setshare6(zh,shd,1);
  monitor(16)send_message:(zh,1,shd);
  monitor(18)wait_answer:(zh,1,shd);
  close(zh,false);

  init_kermit; pause(10);

  state:= state_ri;
  retry_count:= 0;
  outseq:= 0;
  <* main loop *>
  while running do
  case state of
  begin
    <* 1 : Recv_Init *>
    begin
      if -, recv_packet then
      begin
        increase(retry_count);
        if -, retry then goto exit;
        send_packettype('N',0);
      end
      else 
      if (inpackettype='I' or inpackettype='S') and inseq=0 then
      begin
        getinitpacket;
        outpackettype:= 'Y';
        putinitpacket;
        sendpacket;
        if inpackettype='S' then
        begin
          outseq:= (outseq+1) mod 64; retry_count:= 0;
          state:= state_rf;
        end;
      end
      else
      if inpackettype='R' then
      begin
        decode_data(filename);
        state:= state_si;
      end
      else
      if inpackettype='G' and inseq=0 then
      begin
        if indatacount > 0 then
        begin
          getchar(recvdata,1,i);
          if i='L' or i='F' then
          begin
            send_packettype('Y',inseq);
            state:= state_t;
          end
          else
          begin
            movestring(msgtext,1,<:Not Implemented:>);
            send_msg_packet('E',msgtext,0);
          end;
        end
        else
        begin
          movestring(msgtext,1,<:Protocol Error:>);
          send_msg_packet('E',msgtext,0);
        end;
      end
      else
      begin
          p:= 1;
          movestring(msgtext.raf,p,<:Packettype error:>);
          send_msg_packet('E',msgtext,0);
      end;
    end; <* state_ri *>

    <* 2 : Recv_File *>
    begin
      if -, recv_packet then
      begin
        if -, retry then goto exit;
        send_packettype('Y',(out_seq+63) mod 64);
      end
      else
      if inpackettype='F' and inseq=outseq then
      begin
        decode_filename(filename);
        open(zf,4,<::>,0);
        for i:= 1 step 1 until 10 do tail(i):= 0;
        tail(1):= 1;
        tail(6):= systime(7,0.0,0.0);
        if monitor(40,zf,0,tail)=0 and monitor(52,zf,0,tail)=0 then
        begin
          send_packettype('Y',outseq);
          outseq:= (outseq+1) mod 64; retry_count:= 0;
          state:= state_rd;
        end
        else
        begin
          close(zf,true);
          p:= 1;
          movestring(msgtext.raf,p,<:Cannot create file:>);
          send_msg_packet('E',msgtext,outseq);
          state:= state_a;
        end;
      end
      else
      if inpackettype='B' and inseq=outseq then
      begin
        send_packettype('Y',outseq);
        state:= state_c;
      end
      else
      if inpackettype='S' and ((inseq+1) mod 64)=outseq then
      begin
        if -, retry then goto exit;
        putinitpacket;
        outpackettype:='Y';
        outseq:= inseq;
        sendpacket;
        outseq:= (outseq+1) mod 64;
      end
      else
      if inpackettype='Z' and ((inseq+1) mod 64)=outseq then
      begin
        if -, retry then goto exit;
        send_packettype('Y',inseq);
      end
      else
      begin
          p:= 1;
          movestring(msgtext.raf,p,<:Protocol error:>);
          send_msg_packet('E',msgtext,outseq);
        state:= state_a;
      end;
    end; <* state_RF *>

    <* 3 : Recv_Data *>
    begin
      if -, recv_packet then
      begin
        if -, retry then
          state:= state_a
        else
          send_packettype('Y',(out_seq+63) mod 64);
      end
      else
      if inpackettype='D' and inseq=outseq then
      begin
        decode_file(zf);
        send_packettype('Y',outseq);
        outseq:= (outseq+1) mod 64; retry_count:= 0;
      end
      else
      if inpackettype='D' and ((inseq+1) mod 64)=outseq then
      begin
        if -, retry then 
        begin
          close(zf,true);
          monitor(48)remove_entry:(zf,0,tail);
          state:= state_a;
        end
        else
          send_packettype('Y',inseq);
      end
      else
      if inpackettype='Z' and inseq=outseq and indatacount=0 then
      begin
        outchar(zf,'em');
        close(zf,true);
        i:= monitor(46)rename_entry:(zf,0,filename.iaf);
        if i=3 then
        begin
          open(zh,4,filename,0); close(zh,true);
          i:= monitor(48)remove_entry:(zh,0,tail);
          if i=0 then i:=monitor(46)rename_entry:(zf,0,filename.iaf);
        end;
        if i=0 then
        begin
          open(zh,4,filename,0); close(zh,true);
          i:=monitor(50)permanent_entry:(zh,3,tail);
        end;
        if i=0 then
        begin
          send_packettype('Y',outseq);
          outseq:= (outseq+1) mod 64; retry_count:= 0;
          state:= state_rf;
        end
        else
        begin
          close(zf,true);
          monitor(48)remove_entry:(zf,0,tail);
          p:= 1;
          movestring(msgtext.raf,p,<:File Receive Error:>);
          send_msg_packet('E',msgtext,outseq);
          state:= state_a;
        end;
      end
      else
      if inpackettype='Z' and inseq=outseq and
         indatacount > 0 and getchar(recvdata,1,i) extract 12 = 'D'
      then
      begin
        close(zf,true);
        monitor(48)remove_entry:(zf,0,tail);
        send_packettype('Y',outseq);
        outseq:= (outseq+1) mod 64; retry_count:= 0;
        state:= state_rf;
      end
      else
      if inpackettype='F' and ((inseq+1) mod 64)=outseq then
      begin
        if -, retry then 
        begin
          close(zf,true);
          monitor(48)remove_entry:(zf,0,tail);
          state:= state_a;
        end
        else
          send_packettype('Y',inseq);
      end
      else
      begin
        close(zf,true);
        monitor(48)remove_entry:(zf,0,tail);
          p:= 1;
          movestring(msgtext.raf,p,<:Protocol error:>);
          send_msg_packet('E',msgtext,outseq);
        state:= state_a;
      end;
    end; <* state_RD *>  

    <* 4 : state Send_Init *>
    begin
<*      initkermit; *>
      outseq:= retry_count:= 0;
      outpackettype:= 'S';
      putinitpacket;
      sendpacket;
      if -, recv_packet then
      begin
        if -, retry then state:= state_a;
      end
      else
      if (inpackettype='Y') and (inseq=outseq) then
      begin
        getinitpacket;
        outseq:= (outseq+1) mod 64;
        retry_count:= 0;
        open(zf,4,filename,0);
        if monitor(42)lookup_entry:(zf,0,tail)=0 and
           monitor(52)create_areaproc:(zf,0,tail)=0
        then
          state:= state_sf
        else
        begin
          p:= 1; movestring(msgtext,p,<:Cannot open file:>);
          send_msg_packet('E',msgtext,outseq);
          state:= state_a;
        end;
      end
      else
      if -, retry then state:= state_a;
    end; <* state_SI *>

    <* 5 : state Send_File *>
    begin
      encode_filename(filename);
      outpackettype:= 'F';
      sendpacket;
      if -, recv_packet then
      begin
        if -, retry then state:= state_a;
      end
      else
      if (inpackettype='Y' and inseq=outseq) or
         (inpackettype='N' and inseq=(outseq+1) mod 64)
      then
      begin
        outseq:= outseq+1;
        state:= if encode_file(zf) > 0 then state_sd else state_sz;
      end
      else
      if inpackettype='N' then
      begin
        if -, retry then state:= state_a;
      end
      else
        state:= state_a;
    end; <* state_SF *>

    <* 6 : state Send_Data *>
    begin
      outpackettype:= 'D';
      sendpacket;
      if -, recv_packet then
      begin
        if -, retry then state:= state_a;
      end
      else
      if (inpackettype='Y' and inseq=outseq and indatacount=0) or
         (inpackettype='N' and inseq=(outseq+1) mod 64)
      then
      begin
        outseq:= (outseq+1) mod 64; retry_count:= 0;
        state:= if encode_file(zf) > 0 then state_sd else state_sz;
      end
      else
      if (inpackettype='Y' and inseq=outseq) then
      begin
        getchar(recvdata,1,i);
        breakstate:= i;
        outseq:= (outseq+1) mod 64; retry_count:= 0;
        state:= state_sz;
      end
      else
      if inpackettype='N' then
      begin
        if -, retry then state:= state_a;
      end
      else
        state:= state_a;
    end; <* state_SD *>

    <* 7 : state Send_EOF *>
    begin
      send_packettype('Z',outseq);
      if -, recv_packet then
      begin
        if -, retry then state:= state_a;
      end
      else
      if (inpackettype='Y' and inseq=outseq) or
         (inpackettype='N' and inseq=(outseq+1) mod 64)
      then
      begin
        close(zf,true);
        outseq:= (outseq+1) mod 64; retry_count:= 0;
        state:= state_sb;
      end
      else
      if inpackettype='N' then
      begin
        if -, retry then state:= state_a;
      end
      else
        state:= state_a;
    end; <* state_SZ *>

    <* 8 : state Send_Break *>
    begin
      send_packettype('B',outseq);
      if -, recv_packet then
      begin
        if -, retry then state:= state_a;
      end
      else
      if (inpackettype='Y' and inseq=outseq) or
         (inpackettype='N' and inseq=(outseq+1) mod 64)
      then
      begin
        outseq:= (outseq+1) mod 64; retry_count:= 0;
        state:= state_c;
      end
      else
      if inpackettype='N' then
      begin
        if -, retry then state:= state_a;
      end
      else
        state:= state_a;
    end; <* state_SB *>

    <* 9 : state Complete *>
    begin
      init_kermit;
      retry_count:= outseq:= 0;
      state:= state_ri;
    end; <* state_C *>

    <* 10 : state Abort *>
    begin
      init_kermit;
      retry_count:= outseq:= 0;
      state:= state_ri;
    end; <* state_A *>

    <* 11 : state Terminate *>
    begin
      running:= false;
    end;
  end; <* case state - main loop *>

exit:
  <* reset terminal attributes *>
  close(zin,false);
  close(zout,false);
if testbit(0) then
begin
  outchar(zl,'em');
  setposition(zl,0,0);
  close(zl,true);
end;

  open(zh,8,primary_device,0);
  getshare6(zh,shd,1);
  shd(1):= 1;
  for i:= 1 step 1 until 8 do
    shd(3+i):= saveattr(i);
  shd(4):= 132 shift 12;
  setshare6(zh,shd,1);
  monitor(16)send_message:(zh,1,shd);
  monitor(18)wait_answer:(zh,1,shd);
  close(zh,false);
end
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦4c71f7b45⟧ TextFile

Derivation

TextFile
