home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
intelmdsb.zip
/
mdssnd.p80
< prev
next >
Wrap
Text File
|
1988-08-16
|
21KB
|
766 lines
$TITLE ('SEND - HANDLES PACKET TRANSFER BETWEEN LOCAL AND HOST SYSTEM')
send$module:
/* COPYRIGHT (C) 1985, Trustees of Columbia University in the City of New */
/* York. Permission is granted to any individual or institution to use, */
/* copy, or redistribute this software so long as it is not sold for */
/* profit, provided this copyright notice is retained. /*
/* Contains the following public routines: */
/* ctl, getc, prerrpkt, putc, rpack, rpar, send, senhelp, spack, */
/* spar, tochar, and unchar */
do;
/* Global declarations for the communication module */
declare true literally '0FFH';
declare false literally '00H';
declare port1cmd literally '0F5H';
declare port2cmd literally '0F7H';
declare port1dat literally '0F4H';
declare port2dat literally '0F6H';
declare tx$rdy literally '01H';
declare rx$rdy literally '02H';
declare chrmsk literally '07FH';
declare space literally '020H';
declare cr literally '0DH';
declare lf literally '0AH';
declare null literally '00H';
declare crlf literally 'cr,lf,null';
declare bel literally '07H';
declare soh literally '1';
declare eofl literally '0';
declare delete literally '07FH';
declare myquote literally '023H';
declare mynumpads literally '0';
declare mypadchr literally '0';
declare myeol literally 'cr';
declare mytime literally '5';
declare readonly literally '1';
declare writeonly literally '2';
declare rdwr literally '3';
declare noedit literally '0';
declare pksize literally '94';
declare packet(pksize) byte public; /* buffer for packets */
declare input$and byte external; /* Mask for comm input bytes */
declare output$and byte external; /* Mask for comm output bytes */
declare output$or byte external; /* Mask for comm output bytes */
declare state byte external; /* FSM last state */
declare msgnum byte external; /* message number */
declare tries byte external; /* max number of retries */
/* Current Kermit parameters */
declare spsize byte external; /* the present packet size */
declare timeint byte external; /* the present time out */
declare numpads byte external; /* how many pads to send */
declare padchar byte external; /* the present pad character */
declare eol byte external; /* the present eol character */
declare quote byte external; /* the present quote character */
declare pktcnt address; /* tally of good blocks sent */
declare errcnt address; /* tally of error transfers */
declare port byte external; /* the port to use */
declare maxtry byte external; /* the number of retries to attempt */
declare def$drive(5) byte external; /* the default local drive */
declare filename address external; /* the address of the filename */
declare localfile(15) byte; /* full name of file on the local disk */
declare remotefile(11) byte; /* file name sent to remote host */
declare fnptr address;
declare fnchr based fnptr byte;
declare (jfn, status, pklen) address;
declare debug byte external;
/* here are the subroutines */
exit: procedure external;
end exit;
co: procedure(char) external;
declare char byte;
end co;
print: procedure(string) external;
declare string address;
end print;
nout: procedure(n) external;
declare n address;
end nout;
ci: procedure byte external;
end ci;
open: procedure(jfn, filenm, access, mode, status) external;
declare (jfn, filenm, access, mode, status) address;
end open;
read: procedure(jfn, buffer, count, actual, status) external;
declare (jfn, buffer, count, actual, status) address;
end read;
close: procedure(jfn, status) external;
declare (jfn, status) address;
end close;
ready: procedure(port) byte external;
declare (port) byte;
end ready;
newline: procedure external; end newline;
token: procedure address external; end token;
movevar: procedure(offset, source, dest) byte external;
declare offset byte;
declare (source, dest) address;
end movevar;
/* GNXTFN: this routine returns a pointer to the next file in a file */
/* list, or false if there are none. */
gnxtfn: procedure address;
filename = token;
return (filename > 0);
end gnxtfn;
/* PUTC: takes a character and a port, waits for transmit ready from */
/* port and then sends the character to it. Doesn't return a result */
putc: procedure (c, port) public;
declare (c, status, port) byte;
status = 0;
do case port;
do;
call co(c);
end;
do;
do while (status := input(port1cmd) and tx$rdy) = 0; end;
output(port1dat) = ((c and output$and) or output$or);
end;
do;
do while (status := input(port2cmd) and tx$rdy) = 0; end;
output(port2dat) = ((c and output$and) or output$or);
end;
end;
end putc;
/* GETC: this routine waits for something from the receive port then */
/* brings in the character and returns as a result. */
getc: procedure (port) byte public;
declare (c, status, port) byte;
status = 0;
do case port;
do;
c = ci;
end;
do;
do while status = 0;
status = (input(port1cmd) and rx$rdy);
end;
c = (input(port1dat) and input$and);
end;
do;
do while status = 0;
status = (input(port2cmd) and rx$rdy);
end;
c = (input(port2dat) and input$and);
end;
end;
return c;
end getc;
/* TOCHAR: takes a character and converts it to a printable character */
/* by adding a space */
tochar: procedure(char) byte public;
declare char byte;
return (char + space);
end tochar;
/* UNCHAR: undoes 'tochar' */
unchar: procedure(char) byte public;
declare char byte;
return (char - space);
end unchar;
/* CTL: this routine takes a character and toggles the control bit */
/* (ie. ^A becomes A and A becomes ^A). */
ctl: procedure(char) byte public;
declare char byte;
declare cntrlbit literally '040H';
return (char xor cntrlbit);
end ctl;
/* Print the contents of an error packet received from the remote host */
prerrpkt: procedure (pkt) public;
declare pkt address;
declare pkbyte based pkt byte;
call print(.(cr,lf,'Error from remote KERMIT',null));
if pkbyte = null then call newline; /* no message text */
else
do; /* display the message */
call print(.(':\$'));
call print(pkt);
end;
call newline;
end prerrpkt;
/* Close the disk input file */
closeup: procedure;
call close(jfn, .status);
if status > 0 then call print(.('\Unable to close file\$'));
end closeup;
/* spar: Build a Kermit initialization packet */
spar: procedure (a) public;
declare a address;
declare b based a byte;
b = tochar(pksize); /* set up header */
a = a + 1;
b = tochar(mytime);
a = a + 1;
b = tochar(mynumpads);
a = a + 1;
b = ctl(mypadchr);
a = a + 1;
b = tochar(myeol);
a = a + 1;
b = myquote;
end spar;
/* rpar: Extract information from a Kermit initialization packet */
rpar: procedure (addr) public;
declare addr address;
declare item based addr byte;
spsize = unchar(item); /* isn't plm wonderful? */
addr = addr + 1;
timeint = unchar(item);
addr = addr + 1;
numpads = unchar(item);
addr = addr + 1;
padchar = ctl(item);
addr = addr + 1;
eol = unchar(item);
addr = addr + 1;
quote = item;
end rpar;
bufill: procedure (packet) byte;
declare packet address;
declare (pp, maxpp) address;
declare (i, c, done) byte;
declare chr based pp byte;
declare count address;
done = false;
pp = packet;
maxpp = pp + spsize - 8;
do while not done;
call read(jfn, .c, 1, .count, .status);
if status > 0 then
do;
call print(.('Error reading file\$'));
call exit;
end;
if count = 0 then
done = true;
else
do;
if ((c and chrmsk) < space) or
((c and chrmsk) = delete) then
do;
chr = quote;
pp = pp + 1;
chr = ctl(c);
end;
else
if (c and chrmsk) = quote then
do;
chr = quote;
pp = pp + 1;
chr = c;
end;
else
chr = c;
pp = pp + 1;
if pp >= maxpp then done = true;
end;
end;
return (pp - packet);
end bufill;
/* SPACK: this routine sends a packet of data to the host. It takes */
/* four parameters, the type of packet, message number, packet length */
/* and a pointer to a buffer containing what is to be output. It does */
/* not return a value. */
spack: procedure(type, pknum, length, packet) public;
declare (type, pknum, length) byte;
declare packet address;
declare char based packet byte;
declare (i, chksum) byte;
if debug then do;
call print(.('Sending packet ',null));
call nout(pknum);
call print(.(', total packet length is ',null));
call nout(length + 5); /* +5 for soh, count, seq, type, & chksum */
call newline;
end;
i = 1; /* do padding */
do while (i <= numpads);
call putc(padchar, port);
if debug then call co('p');
i = i + 1;
end;
chksum = 0;
/* send the packet header */
call putc(soh, port); /* send packet marker (soh) */
if debug then call co('s');
i = tochar(length + 3);
chksum = i;
call putc(i, port); /* send character count */
if debug then call co('c');
i = tochar(pknum);
chksum = chksum + i; /* add in packet number */
call putc(i, port); /* send packet number */
if debug then call co('n');
chksum = chksum + type; /* add in packet type */
call putc(type, port); /* send the packet type */
if debug then call co(type);
/* now send the data */
do i = 1 to length;
chksum = chksum + char;
call putc(char, port);
if debug then call co(char); /* was co('.') */
packet = packet + 1;
end;
/* check sum generation */
chksum = ((chksum + (chksum and 192) / 64) and 63);
chksum = tochar(chksum);
call putc(chksum, port); /* send the chksum */
if debug then call co('c');
call putc(eol, port); /* terminate the packet */
if debug then do;
call print(.('e\$'));
call co('.');
end;
end spack;
/* RPACK: this routine receives a packet from the host. It takes three */
/* parameters: the address of where to put the length of the packet, */
/* the address of where to put the packet number and the address of the */
/* buffer to receive the data. It returns true for a positive reply or */
/* false for a NEGative reply. */
rpack: procedure(length, pknum, packet) byte public;
declare (length, pknum, packet, pkptr) address;
declare len based length byte;
declare num based pknum byte;
declare pk based pkptr byte;
declare (i, index, chksum, hischksum, type, inchar, msglen) byte;
declare buffer(128) byte;
if debug then call print(.('rpack | ',null));
inchar = 0; /* wait for a header */
do while inchar <> soh; inchar = getc(port); end;
index = 0;
inchar = getc(port);
do while (inchar <> myeol);
buffer(index) = inchar;
index = index + 1;
inchar = getc(port);
end;
buffer(index) = null;
if debug then
do;
call print(.('Received packet: [',null));
call print(.buffer);
call print(.(']\Length of message: $'));
end;
msglen = index - 1;
if debug then
do;
call nout(msglen);
call newline;
call print(.('Length field: $'));
call nout(buffer(0));
call co('_');
end;
len = unchar(buffer(0)-3);
if debug then
do;
call nout(len);
call print(.('\Message number: $'));
call nout(buffer(1));
call co('_');
end;
num = unchar(buffer(1));
if debug then
do;
call nout(num);
call print(.('\Type: $'));
end;
type = buffer(2);
if debug then
do;
call co(type);
call newline;
end; /* debug */
pkptr = packet;
chksum = buffer(0) + buffer(1) + buffer(2);
i = 3; /* index of first data character */
do while (i < msglen);
chksum = (pk := buffer(i)) + chksum;
pkptr = pkptr+1;
i = i + 1;
end;
pk = null; /* terminate with null for printing */
chksum = (chksum + ((chksum and 192) / 64)) and 63;
if debug then
do;
call print(.('His checksum: $'));
call nout(buffer(msglen));
call co('_');
end; /* debug */
hischksum = unchar(buffer(msglen));
if debug then
do;
call nout(hischksum);
call print(.('\Our checksum: $'));
call nout(chksum);
call newline;
end; /* debug */
if chksum <> hischksum then
do;
if debug then call print(.('Bad checksum received\$'));
return false;
end;
return type;
end rpack;
/* SDATA: this routine sends the data from the buffer area to the host. */
/* It takes no parameters but returns the next state depending on the */
/* type of acknowledgement. */
sdata: procedure byte;
declare (num, length, retc, retst, c) byte;
if debug then call print(.('sdata...\$'));
if tries > maxtry then return 'A';
else tries = tries + 1;
if ready(0) > 0 then
do; /* There is a keystroke ready */
c = getc(0);
if (c = 24 or c = 26) then /* ctrl-X or ctrl-Z */
do;
call closeup;
packet(0) = 'D'; /* Delete this file */
call spack('Z', msgnum, 1, .packet);
if c = 26 then /* ctrl-Z means stop all */
do;
msgnum = (msgnum + 1) mod 64;
return 'B';
end;
else
do;
if gnxtfn = false then /* No more file names */
do;
msgnum = (msgnum + 1) mod 64;
return 'B';
end;
else return 'S';
end;
end;
end;
call spack('D', msgnum, pklen, .packet);
retc = rpack(.length, .num, .packet);
if (retc = 'N') then
do;
if (((msgnum + 1) mod 64) = num) then /* NAK for next packet */
retc = 'Y'; /* force into next test */
else
do;
errcnt = errcnt + 1;
retst = state; /* establish return state */
end;
end;
if (retc = 'Y') then
do;
tries = 0;
pktcnt = pktcnt + 1;
msgnum = (msgnum + 1) mod 64;
pklen = bufill(.packet);
if pklen > 0 then retst = 'D';
else retst = 'Z';
end;
else if (retc = 'E') then
do;
call prerrpkt(.packet);
return 'A';
end;
else if (retc = false) then retst = state;
else return 'A';
/* Report transfer progress */
call print(.(cr,'Packets sent: $'));
call nout(pktcnt);
call print(.('; number of retries: $'));
call nout(errcnt);
if debug then call print(.(crlf));
return retst;
end sdata;
/* SFILE: this routine sends a packet to the host which contains the */
/* filename of the file being sent so that the file can be created at */
/* the host end. It returns a new state depending on the nature of the */
/* the host's acknowledgement. */
sfile: procedure byte;
declare (num, length, retc) byte;
if debug then call print(.('sfile...\$'));
if tries > maxtry then return 'A';
else tries = tries + 1;
length = 0; /* count characters in filename */
fnptr = .remotefile;
do while fnchr > space;
length = length + 1;
fnptr = fnptr + 1;
end;
if debug then call print(.('\Filename is: $'));
call print(.localfile);
if (filename > 0) then
do;
call print(.(' to $'));
call print(.remotefile);
end;
call newline;
if debug then
do;
call print(.('File name length is: $'));
call nout(length);
call newline;
end; /* debug */
call spack('F', msgnum, length, .remotefile);
retc = rpack(.length, .num, .packet);
if (retc = 'N') then return state;
if (retc = 'E') then
do;
call prerrpkt(.packet);
return 'A';
end;
if (retc <> 'Y') then return 'A';
/* here on valid acknowledgement */
tries = 0;
msgnum = (msgnum + 1) mod 64;
pktcnt = 0;
errcnt = 0;
pklen = bufill(.packet);
if pklen > 0 then return 'D';
else return 'Z';
end sfile;
/* SEOF: this routine is used when eof is detected, it closes up and */
/* returns the new state as usual. */
seof: procedure byte;
declare (num, length, retc) byte;
if debug then call print(.('seof...\$'));
if tries > maxtry then return 'A';
else tries = tries + 1;
call spack('Z', msgnum, 0, .packet);
retc = rpack(.length, .num, .packet);
if (retc = 'N') then return state;
if (retc = 'E') then
do;
call prerrpkt(.packet);
return 'A';
end;
if (retc <> 'Y') then return 'A';
/* here on valid acknowledgement */
tries = 0;
call closeup;
if gnxtfn = false then
do;
msgnum = (msgnum + 1) mod 64;
return 'B';
end;
else return 'S';
end seof;
/* SINIT: this routine does initializations and opens the file to be */
/* sent; it returns a new state depending on the outcome of trying to */
/* open the file. */
sinit: procedure byte;
declare (len, num, retc) byte;
declare foffset byte;
call print(.('\Sending $'));
if debug then call print(.('sinit...\$'));
if tries > maxtry then return 'A';
else tries = tries + 1;
if filename = 0 then return 'A';
call spar(.packet);
call spack('S', msgnum, 6, .packet); /* send start packet */
retc = rpack(.len, .num, .packet);
if (retc = 'N') then return state;
if (retc = 'E') then
do;
call prerrpkt(.packet);
return 'A';
end;
if (retc <> 'Y') then return 'A';
/* here on valid acknowledgement */
call rpar(.packet);
if eol = 0 then eol = myeol;
if quote = 0 then quote = myquote;
tries = 0;
msgnum = (msgnum + 1) mod 64;
/* Crack the file name */
fnptr = filename;
if fnchr = ':' then
do; /* File name on command has a drive */
foffset = movevar(0,filename,.localfile); /* Use file name as-is */
foffset = movevar(0,filename+4,.remotefile); /* Strip drive */
end;
else
do;
foffset = movevar(0,.def$drive,.localfile); /* Build local file name */
foffset = movevar(foffset,filename,.localfile); /* from default drive */
foffset = movevar(0,filename,.remotefile);
end;
filename = token; /* Check for second operand */
if (filename > 0) then /* use 2nd operand for remote file name */
foffset = movevar(0,filename,.remotefile);
call open(.jfn, .localfile, readonly, noedit, .status);
if (status > 0) then
do;
call print(.('\Cannot open file $'));
call print(.localfile);
call print(.(crlf));
return 'A';
end;
else return 'F';
end sinit;
/* SBREAK: this module breaks the flow of control at the end of a */
/* transmission and allows the send routine to terminate by returning */
/* either a successful or failure condition to the main kermit routine. */
sbreak: procedure byte;
declare (num, length, retc) byte;
if debug then call print(.('sbreak...\$'));
if tries > maxtry then return 'A';
else tries = tries + 1;
call spack('B', msgnum, 0, .packet);
retc = rpack(.length, .num, .packet);
if (retc = 'N') then return state;
if (retc = 'E') then
do;
call prerrpkt(.packet);
return 'A';
end;
if (retc <> 'Y') then return 'A';
/* we only get here if we received a valid acknowledgement */
tries = 0;
msgnum = (msgnum + 1) mod 64;
return 'C';
end sbreak;
/* Display help for the SEND command */
senhelp: procedure public;
call print(.('\SEND\\$'));
call print(.(' The SEND command causes Kermit to send a file $'));
call print(.('to the remote Kermit.\\$'));
call print(.('Syntax:\\$'));
call print(.(' SEND file [remote-file]\\$'));
call print(.('If the "remote-file" is specified, that name will be $'));
call print(.('used by the remote\$'));
call print(.('Kermit.\\$'));
end senhelp;
/* SEND: This is the main code for the send command. It is an FSM for */
/* sending files. The main loop calls various routines until it */
/* finishes or an error occurs. */
send: procedure public;
filename = token; /* Get the command line file name */
if (filename = 0) then
do;
call print(.('No files specified\$'));
return;
end;
state = 'S'; /* start in Send-Init state */
msgnum = 0;
tries = 0;
do while (state <> true and state <> false);
if debug then
do;
call print(.('state : ',null));
call co(state);
call newline;
end;
if state = 'D' then state = sdata;
else
if state = 'F' then state = sfile;
else
if state = 'Z' then state = seof;
else
if state = 'S' then state = sinit;
else
if state = 'B' then state = sbreak;
else
if state = 'C' then state = true;
else
if state = 'A' then state = false;
else state = false;
end;
if state then call print(.('\OK',bel,crlf));
else call print(.('Send failed\$'));
end send;
end send$module;