home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
intelmdsa.tar.gz
/
intelmdsa.tar
/
md2rec.plm
< prev
next >
Wrap
Text File
|
1988-08-16
|
9KB
|
385 lines
/* RECEIVE: Routines for reading from the console and the serial ports */
recv$module:
do;
declare true literally '0FFH';
declare false literally '00H';
declare port1dat literally '0F4H';
declare port1cmd literally '0F5H';
declare port2dat literally '0F6H';
declare port2cmd literally '0F7H';
declare rx$rdy literally '02H';
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 writeonly literally '2';
declare noedit literally '0';
declare state byte;
declare tries byte;
declare msgnum byte;
declare maxtry literally '5';
declare eol byte;
declare port byte external;
declare driver byte external;
declare debug byte external;
declare pksize literally '94';
declare packet(pksize) byte external;
declare (jfn, count, status) address;
declare oldtry byte;
ci: procedure byte external;
end ci;
csts: procedure byte external;
end csts;
co: procedure(char)external;
declare char byte;
end co;
print: procedure(string)external;
declare string address;
end print;
nout: procedure(num)external;
declare num address;
end nout;
newline: procedure external; end newline;
open: procedure(jfn, file, access, mode, status) external;
declare (jfn, file, access, mode, status) address;
end open;
write: procedure(jfn, buffer, count, status) external;
declare (jfn, buffer, count, status) address;
end write;
close: procedure(jfn, status) external;
declare (jfn, status) address;
end close;
exit: procedure external;
end exit;
getc: procedure(port) byte external;
declare port byte;
end getc;
ctl: procedure(char) byte external;
declare char byte;
end ctl;
spack: procedure(type, pknum, length, packet) external;
declare (type, pknum, length, 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;
ready: procedure (port) byte public;
declare (port, status) byte;
do case port;
do;
status = csts;
end;
do;
status = input(port1cmd) and rx$rdy;
end;
do;
status = input(port2cmd) and rx$rdy;
end;
end;
return status;
end ready;
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 write(jfn, .char, 1, .status);
if status > 0 then do;
call print(.('Write error ',null));
call nout(status);
call newline;
call exit;
end;
packet = packet + 1;
i = i + 1;
end;
if debug then call newline;
end bufemp;
rinit: procedure byte;
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, .packet);
if (retc <> 'S') then return state;
/* here on send init received */
call rpar(.packet);
call spar(.packet);
call spack('Y', msgnum, 6, .packet);
oldtry = tries;
tries = 0;
msgnum = (msgnum + 1) mod 64;
return 'F';
end rinit;
/* to insert dirver address infront of filename */
insert : procedure(c,length);
declare (index,c,length) byte ;
index = length;
do while (index <> 0FFH);
packet(index + 4) = packet(index);
index = index - 1 ;
end;
packet(0) = ':';
packet(1) = 'F';
packet(2) = c ;
packet(3) = ':';
length = length + 4;
end insert;
rfile: procedure byte;
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, .packet);
if retc = 'S' then do;
if (oldtry > maxtry) then return 'A';
else oldtry = oldtry + 1;
if (num = msgnum - 1) then
do;
call spar(.packet);
call spack('Y', num, 6 , .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(.packet);
call newline;
if len > 10 then
do;
call print(.('*** error **** $'));
call print(.('received filename has more than 6 characters',crlf));
return('A') ;
end;
if (driver < 5 ) then
do;
do case driver;
; /* driver = 0 */
call insert('1',len); /* driver 1 */
call insert('2',len); /* driver 2 */
call insert('3',len); /* driver 3 */
call insert('4',len); /* driver 4 */
end ;
end;
else
do;
call print(.('disk driver number : 0|1|2|3|4 ',crlf));
return ('A') ;
end;
call open(.jfn, .packet, writeonly, noedit, .status);
if status > 0 then
do;
call print (.('Unable to create file, error ', null));
call nout(status);
call newline;
return 'A';
end;
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;
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, .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(.packet);
call spack('Y', num, 6, .packet);
tries = 0;
return state;
end;
else return 'A';
end;
call bufemp(.packet, len);
call spack('Y', msgnum, 0, 0);
oldtry = tries;
tries = 0;
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 close(jfn, .status);
if status > 0 then call print(.(cr,lf,'Unable to close file',null));
msgnum = (msgnum + 1) mod 64;
return 'F';
end;
return state;
end rdata;
recv: procedure byte public;
if debug then call print(.('Receive a file',crlf));
state = 'R';
msgnum = 0;
tries = 0;
oldtry = 0;
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;
/* to receive a file from VAX when command GET is used */
getrecv: procedure byte public;
if debug then call print(.('Receive a file',crlf));
state = 'F';
msgnum = 1;
tries = 0;
oldtry = 0;
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 ('W');
else return false;
end;
end getrecv;
end recv$module;