home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
intelrmx86.tar.gz
/
intelrmx86.tar
/
recv.p86
< prev
next >
Wrap
Text File
|
1985-10-28
|
6KB
|
305 lines
/* RECEIVE: Routines for reading from the console and the serial ports */
$compact
$optimize(3)
recv$module:
do;
$include(:INC:LTKSEL.LIT)
declare true literally '0FFH';
declare false literally '00H';
declare null literally '00';
declare cr literally '0DH';
declare lf literally '0AH';
declare crlf literally 'cr,lf,null';
declare myquote literally '023H';
declare chrmsk literally '07FH';
declare state byte;
declare tries byte;
declare msgnum byte;
declare maxtry literally '5';
declare eol byte;
declare debug byte external;
declare iobuff(1024) byte external;
declare status word external;
declare pksize literally '94';
declare send$packet(pksize) byte external;
declare recv$packet(pksize) byte external;
declare count word;
declare oldtry byte;
declare byte$in dword;
declare file$conn token external;
declare filename structure
(len byte,
name(80) byte) external;
declare qopen byte external;
declare dummy byte;
$include(:INC:USWBF.EXT)
$include(:INC:UGTARG.EXT)
check$error: procedure(mode) byte external;
declare mode byte;
end check$error;
file$open: procedure(mode) external;
declare mode byte;
end file$open;
file$close: procedure external;
end file$close;
co: procedure(char)external;
declare char byte;
end co;
print: procedure(string)external;
declare string pointer;
end print;
nout: procedure(num)external;
declare num word;
end nout;
noutd: procedure(num)external;
declare num dword;
end noutd;
newline: procedure external; end newline;
ctl: procedure(char) byte external;
declare char byte;
end ctl;
putc: procedure (c,conn) external;
declare c byte;
declare conn token;
end putc;
do$put: procedure (conn) external;
declare conn token;
end do$put;
spack: procedure(type, pknum, length, packet) external;
declare (type, pknum, length) byte;
declare packet address;
end spack;
rpack: procedure(length, pknum, packet) byte external;
declare (length, pknum, packet) address;
end rpack;
spar: procedure (a) external;
declare a address;
end spar;
rpar: procedure (a) external;
declare a address;
end rpar;
bufemp: procedure(packet, len);
declare packet address;
declare inchar based packet byte;
declare (i, char, len) byte;
if debug then call print(@('Writing to disk...',null));
i = 0;
do while (i < len);
char = inchar;
if char = myquote then do;
packet = packet + 1;
i = i + 1;
char = inchar;
if (char and chrmsk) <> myquote then char = ctl(char);
end;
if debug then call co(char);
call putc(char,file$conn);
packet = packet + 1;
byte$in=byte$in+1;
i = i + 1;
end;
if debug then call newline;
call do$put(file$conn);
end bufemp;
rinit: procedure byte public;
declare (len, num, retc) byte;
if tries > maxtry then return 'A';
else tries = tries + 1;
if debug then call print(@('rinit...',crlf));
retc = rpack(.len, .num, .recv$packet);
if (retc <> 'S') then return state;
/* here on send init received */
call rpar(.recv$packet);
call spar(.send$packet);
call spack('Y', msgnum, 6, .send$packet);
oldtry = tries;
tries = 0;
byte$in=0;
msgnum = (msgnum + 1) mod 64;
return 'F';
end rinit;
rfile: procedure byte public;
declare (len, num, retc) byte;
if tries > maxtry then return 'A';
else tries = tries + 1;
if debug then call print(@('rfile...',crlf));
retc = rpack(.len, .num, .recv$packet);
if retc = 'S' then do;
if (oldtry > maxtry) then return 'A';
else oldtry = oldtry + 1;
if (num = msgnum - 1) then
do;
call spar(.send$packet);
call spack('Y', num, 6 , .send$packet);
tries = 0;
return state;
end;
else return 'A';
end;
if retc = 'Z' then do;
if (oldtry > maxtry) then return 'A';
else oldtry = oldtry + 1;
if (num = msgnum - 1) then
do;
call spack('Y', num, 0, 0);
tries = 0;
return state;
end;
else return 'A';
end;
if retc = 'F' then do;
if (num <> msgnum) then return 'A';
call print(@(cr,lf,'Receiving ',null));
call print(@recv$packet);
call newline;
if not qopen then do;
dummy=DQ$SWITCH$BUFFER(@recv$packet,@status);
if check$error(0) then return 'A';
dummy=DQ$GET$ARGUMENT(@filename,@status);
if check$error(0) then return 'A';
call file$open(2);
end;
if not qopen then return 'A';
call spack('Y', msgnum, 0, 0);
oldtry = tries;
tries = 0;
msgnum = (msgnum + 1) mod 64;
return 'D';
end;
if retc = 'B' then do;
if (num <> msgnum) then return 'A';
call spack('Y', msgnum, 0, 0);
return 'C';
end;
return state;
end rfile;
rdata: procedure byte public;
declare (num, len, retc) byte;
if tries > maxtry then return 'A';
else tries = tries + 1;
if debug then call print(@('rdata...',crlf));
retc = rpack(.len, .num, .recv$packet);
if retc = 'D' then do;
if (num <> msgnum) then do;
if (oldtry > maxtry) then return 'A';
else oldtry = oldtry + 1;
if (num = msgnum - 1) then do;
call spar(.send$packet);
call spack('Y', num, 6, .send$packet);
tries = 0;
return state;
end;
else return 'A';
end;
call bufemp(.recv$packet, len);
call spack('Y', msgnum, 0, 0);
oldtry = tries;
tries = 0;
call print(@('recieved ',null));
call noutd(byte$in);
call print(@(' bytes ',cr,null));
msgnum = (msgnum + 1) mod 64;
return 'D';
end;
if retc = 'F' then do;
if (oldtry > maxtry) then return 'A';
else oldtry = oldtry + 1;
if (num = msgnum - 1) then
do;
call spack('Y', num, 0, 0);
tries = 0;
return state;
end;
else return 'A';
end;
if retc = 'Z' then do;
if (num <> msgnum) then return 'A';
call spack('Y', msgnum, 0, 0);
call file$close;
msgnum = (msgnum + 1) mod 64;
return 'F';
end;
call spack('N', msgnum, 0, 0);
return state;
end rdata;
recv$setup: procedure public;
state = 'R';
msgnum = 0;
tries = 0;
oldtry = 0;
end recv$setup;
recv: procedure byte public;
if debug then call print(@('Receive a file',crlf));
call recv$setup;
do while true;
if state = 'D' then state = rdata;
else
if state = 'F' then state = rfile;
else
if state = 'R' then state = rinit;
else
if state = 'C' then return true;
else return false;
end;
end recv;
end recv$module;