|
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: 26880 (0x6900)
Types: TextFile
Names: »tkermit9 «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »tkermit9 «
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,
state_ri, state_rf, state_rd, state_si, state_sf, state_sd,
state_sz, state_sb, state_c, state_a, state_t;
boolean running, binary;
integer array tail(1:10),
alfa(0:255), saveattr(1:8), shd(1:12);
real array recvdata, senddata, msgtext(1:43), 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:=packetsize:= 68;
timeout := 60;
numpad := 0;
padchar := 0;
endchar := 'cr';
startchar := 'soh';
cntrlquote := '#';
bit8quote := '&';
checktype := '1';
repchar := 'ü';
<* 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>='@' 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(16,1,timer), zout(16,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;
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 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;
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);
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 ;
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 *>
outdatacount:= 9;
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);
if bit8quote=0 then outdatacount:= 6 else
if checktype=0 then outdatacount:= 7 else
if repchar=0 then outdatacount:= 8 ;
end; <* procedure putinitpacket *>
procedure getinitpacket;
begin <* get init parameters *>
integer ch;
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;
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;
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◀