home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
ucsdibmpc.tar.gz
/
ucsdibmpc.tar
/
kermit.text
< prev
next >
Wrap
Text File
|
1984-05-23
|
9KB
|
247 lines
program kermit;
(* $R-*) (* turn range checking off *)
(* $L+*)
USES {$u kermglob.code} kermglob,
{$U kermutil.code} kermutil,
(* {$U kermpack.code} kermpack, *)
{$U parser.code} parser,
{$U helper.code} helper,
{$U sender.code} sender,
{$U receiver.code} receiver;
{
Modifications by SP, 25 Oct 1983: adapt to IBM Version IV.1
Delete keyboard and serial buffering: provided by system already.
Additional mods by SP, 18 Mar 1984: make all strings 255 chars long
13 May 84: Incorporate screen control through syscom record entries
for portability
}
procedure showparms;
forward;
procedure connect;
(* connect to remote host and transceive *)
var ch: char;
close: boolean;
procedure read_esc;
(* read character after esc char and interpret it *)
begin
repeat
until read_ch(keyport,ch); (* wait until they've typed something in *)
if (ch in ['a'..'z']) then (* uppercase it *)
ch := chr(ord(ch) - ord('a') + ord('A'));
if ch in ['B','C','S','?'] then
case ch of
'B': sendbrk; (* B: send a break to the IBM *)
'C': close := true; (* C: end connection *)
'S': begin (* S: show status *)
noun := allsym;
showparms
end; (* S *)
'?': begin (* ?: show options *)
writeln('B Send a BREAK signal.');
writeln('C Close Connection, return to KERMIT-UCSD command level.');
writeln('Q Query Status of connection');
writeln('F Send Control-F character to remote host.' );
writeln('S Send Control-S character to remote host.' );
writeln('? Print this list');
writeln('^',esc_char,' send the escape character itself to the');
writeln(' remote host.')
end; (* ? *)
end (* case *)
else if ch = esc_char then (* ESC-char: send it out *)
begin
if half_duplex then
begin
write(ch); { changed from echo() by SP }
write_ch(oport,ch)
end (* if *)
end (* else if *)
else (* anything else: ignore *)
write(chr(bell))
end; (* read_esc *)
begin (* connect *)
clear_buf(keyport); (* empty keyboard buffer *)
clear_buf(inport); (* empty remote input buffer *)
writeln('Connecting to host...type CTRL-',ctl(esc_char),' C to exit');
close := false;
repeat
if read_ch(inport,ch) then (* if char from host then *)
echo(ch); (* echo it *)
if read_ch(keyport,ch) then (* if char from keyboard then *)
if ch <> esc_char then (* if not ESC-char then *)
begin
if half_duplex then (* echo it if half-duplex *)
write(ch); { changed from echo() by sp }
write_ch(oport,ch) (* send it out the port *)
end (* if *)
else (* ch = esc_char *) (* else is ESC-char so *)
read_esc; (* interpret next char *)
until close; (* if still connected, get more *)
writeln('Disconnected')
end; (* connect *)
procedure fill_parity_array;
(* parity value table for even parity...not(entry) = odd parity *)
const min = 0;
max = 126;
var i, shifter, counter: integer;
minch, maxch, ch: char;
r: char_int_rec;
begin
minch := chr(min);
maxch := chr(max);
case parity of
evenpar: for ch := minch to maxch do begin
r.ch := ch; (* put char into variant record *)
shifter := aand(r.i,255); (* mask off parity bit *)
counter := 0;
for i := 1 to 7 do begin (* count the 1's *)
if odd(shifter) then
counter := counter + 1;
shifter := shifter div 2
end; (* for i *)
if odd(counter) then (* stick a 1 on if necessary *)
parity_array[ch] := chr(aor(ord(ch),128))
else
parity_array[ch] := chr(aand(ord(ch),127))
end; (* for ch *) (* case even *)
oddpar: for ch := minch to maxch do begin
r.ch := ch; (* put char into variant record *)
shifter := aand(r.i,255); (* mask off parity bit *)
counter := 0;
for i := 1 to 7 do begin (* count the 1's *)
if odd(shifter) then
counter := counter + 1;
shifter := shifter div 2
end; (* for i *)
if odd(counter) then (* stick a 1 on if necessary *)
parity_array[ch] := chr(aand(ord(ch),127))
else
parity_array[ch] := chr(aor(ord(ch),128))
end; (* for ch *) (* case odd *)
markpar:
for ch := minch to maxch do (* stick a 1 on all chars *)
parity_array[ch] := chr(aor(ord(ch),128));
spacepar:
for ch := minch to maxch do (* mask off parity on all chars *)
parity_array[ch] := chr(aand(ord(ch),127));
nopar:
for ch := minch to maxch do (* don't mess with parity bit at all *)
parity_array[ch] := ch;
end; (* case *)
end; (* fill_parity_array *)
$I setshow.text
procedure initialize;
var ch: char;
begin
pad := mypad;
padchar := chr(mypchar);
xeol := chr(my_eol);
esc_char := chr(my_esc);
quote := my_quote;
ctlset := [chr(1)..chr(31),chr(del),quote];
half_duplex := false;
debug := false;
emulating := false;
fwarn := false;
spsiz := max_pack;
rpsiz := max_pack;
n := 0;
parity := nopar;
initvocab;
fill_parity_array;
ibm := false;
xon := chr(17);
bufpos := 1;
bufend := 0;
baud := defaultbaud;
setup_comm
end; (* initialize *)
procedure closeup;
begin
page( output )
end; (* closeup *)
begin (* main kermit program *)
initialize;
repeat
write('Kermit-UCSD> ');
readstr(keyport,line);
case parse of
unconfirmed: writeln('Unconfirmed');
parm_expected: writeln('Parameter expected');
ambiguous: writeln('Ambiguous');
unrec: writeln('Unrecognized command');
fn_expected: writeln('File name expected');
ch_expected: writeln('Single character expected');
null: case verb of
consym: connect;
helpsym: help;
recsym: begin
recsw(rec_ok);
gotoxy(0,debugline);
write(chr(bell));
if rec_ok then
writeln('successful receive')
else
writeln('unsuccessful receive');
(*$I-*) (* set i/o checking off *)
close(oldf); { why??? }
if not rec_ok then
close(f); { added by SP }
(*$I+*) (* set i/o checking back on *)
gotoxy(0,promptline);
end; (* recsym *)
sendsym: begin
uppercase(xfilename);
sendsw(send_ok);
gotoxy(0,debugline);
write(chr(bell));
if send_ok then
writeln('successful send')
else
writeln('unsuccessful send');
(*$I-*) (* set i/o checking off *)
close(oldf);
(*$I+*) (* set i/o checking back on *)
gotoxy(0,promptline);
end; (* sendsym *)
setsym: set_parms;
show_sym: show_parms;
end; (* case verb *)
end; (* case parse *)
until (verb = exitsym) or (verb = quitsym);
closeup
end. (* kermit *)