home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / ucsdibmpc.zip / kermit.text < prev    next >
Text File  |  1984-05-23  |  9KB  |  247 lines
  1. program kermit;
  2.  
  3. (* $R-*) (* turn range checking off *)
  4. (* $L+*)
  5.  
  6. USES {$u kermglob.code} kermglob,
  7.      {$U kermutil.code} kermutil,
  8.      (* {$U kermpack.code} kermpack, *)
  9.      {$U parser.code}   parser,
  10.      {$U helper.code}   helper,
  11.      {$U sender.code}   sender,
  12.      {$U receiver.code} receiver;
  13.  
  14. {
  15.   Modifications by SP, 25 Oct 1983: adapt to IBM Version IV.1
  16.   Delete keyboard and serial buffering: provided by system already.
  17.  
  18.   Additional mods by SP, 18 Mar 1984: make all strings 255 chars long
  19.  
  20.   13 May 84: Incorporate screen control through syscom record entries
  21.              for portability
  22. }
  23.  
  24.  
  25. procedure showparms;
  26. forward;
  27.  
  28.  
  29. procedure connect;
  30.  
  31. (* connect to remote host and transceive *)
  32.  
  33. var ch: char;
  34.     close: boolean;
  35.  
  36.   procedure read_esc;
  37.  
  38.   (* read character after esc char and interpret it *)
  39.  
  40.     begin
  41.       repeat
  42.       until read_ch(keyport,ch);       (* wait until they've typed something in *)
  43.       if (ch in ['a'..'z']) then  (* uppercase it *)
  44.           ch := chr(ord(ch) - ord('a') + ord('A'));
  45.       if ch in ['B','C','S','?'] then
  46.           case ch of
  47.               'B': sendbrk;       (* B: send a break to the IBM *)
  48.               'C': close := true; (* C: end connection *)
  49.               'S': begin          (* S: show status *)
  50.                       noun := allsym;
  51.                       showparms
  52.                    end; (* S *)
  53.               '?': begin          (* ?: show options *)
  54.                   writeln('B    Send a BREAK signal.');
  55.                   writeln('C    Close Connection, return to KERMIT-UCSD command level.');
  56.                   writeln('Q    Query Status of connection');
  57.                   writeln('F    Send Control-F character to remote host.' );
  58.                   writeln('S    Send Control-S character to remote host.' );
  59.                   writeln('?    Print this list');
  60.                   writeln('^',esc_char,'   send the escape character itself to the');
  61.                   writeln('     remote host.')
  62.                 end; (* ? *)
  63.             end (* case *)
  64.       else if ch = esc_char then  (* ESC-char: send it out *)
  65.         begin
  66.           if half_duplex then
  67.             begin
  68.               write(ch); { changed from echo() by SP }
  69.               write_ch(oport,ch)
  70.             end (* if *)
  71.         end (* else if *)
  72.       else                        (* anything else: ignore *)
  73.           write(chr(bell))
  74.     end; (* read_esc *)
  75.  
  76.   begin (* connect *)
  77.     clear_buf(keyport);                    (* empty keyboard buffer *)
  78.     clear_buf(inport);                    (* empty remote input buffer *)
  79.     writeln('Connecting to host...type CTRL-',ctl(esc_char),' C to exit');
  80.     close := false;
  81.     repeat
  82.         if read_ch(inport,ch) then        (* if char from host then *)
  83.             echo(ch);                   (* echo it *)
  84.  
  85.         if read_ch(keyport,ch) then        (* if char from keyboard then *)
  86.             if ch <> esc_char then      (* if not ESC-char then *)
  87.               begin
  88.                 if half_duplex then       (* echo it if half-duplex *)
  89.                     write(ch); { changed from echo() by sp }
  90.                 write_ch(oport,ch)     (* send it out the port *)
  91.               end (* if *)
  92.             else (* ch = esc_char *)    (* else is ESC-char so *)
  93.               read_esc;                   (* interpret next char *)
  94.     until close;                      (* if still connected, get more *)
  95.     writeln('Disconnected')
  96.   end; (* connect *)
  97.  
  98.  
  99. procedure fill_parity_array;
  100.  
  101. (* parity value table for even parity...not(entry) = odd parity *)
  102.  
  103. const min = 0;
  104.       max = 126;
  105.  
  106. var i, shifter, counter: integer;
  107.     minch, maxch, ch: char;
  108.     r: char_int_rec;
  109.  
  110. begin
  111.    minch := chr(min);
  112.    maxch := chr(max);
  113.    case parity of
  114.       evenpar: for ch := minch to maxch do begin
  115.                   r.ch := ch;               (* put char into variant record *)
  116.                   shifter := aand(r.i,255); (* mask off parity bit *)
  117.                   counter := 0;
  118.                   for i := 1 to 7 do begin       (* count the 1's *)
  119.                      if odd(shifter) then
  120.                         counter := counter + 1;
  121.                      shifter := shifter div 2
  122.                   end; (* for i *)
  123.                   if odd(counter) then       (* stick a 1 on if necessary *)
  124.                      parity_array[ch] := chr(aor(ord(ch),128))
  125.                   else
  126.                      parity_array[ch] := chr(aand(ord(ch),127))
  127.                end; (* for ch *) (* case even *)
  128.       oddpar:  for ch := minch to maxch do begin
  129.                   r.ch := ch;                (* put char into variant record *)
  130.                   shifter := aand(r.i,255);  (* mask off parity bit *)
  131.                   counter := 0;
  132.                   for i := 1 to 7 do begin        (* count the 1's *)
  133.                      if odd(shifter) then
  134.                          counter := counter + 1;
  135.                      shifter := shifter div 2
  136.                   end; (* for i *)
  137.                   if odd(counter) then        (* stick a 1 on if necessary *)
  138.                      parity_array[ch] := chr(aand(ord(ch),127))
  139.                   else
  140.                      parity_array[ch] := chr(aor(ord(ch),128))
  141.                end; (* for ch *) (* case odd *)
  142.       markpar:
  143.           for ch := minch to maxch do     (* stick a 1 on all chars *)
  144.               parity_array[ch] := chr(aor(ord(ch),128));
  145.       spacepar:
  146.           for ch := minch to maxch do     (* mask off parity on all chars *)
  147.               parity_array[ch] := chr(aand(ord(ch),127));
  148.       nopar:
  149.           for ch := minch to maxch do     (* don't mess with parity bit at all *)
  150.               parity_array[ch] := ch;
  151.     end; (* case *)
  152.   end; (* fill_parity_array *)
  153.  
  154.  
  155. $I setshow.text
  156.  
  157.  
  158. procedure initialize;
  159.  
  160. var ch: char;
  161.  
  162.   begin
  163.     pad := mypad;
  164.     padchar := chr(mypchar);
  165.     xeol := chr(my_eol);
  166.     esc_char := chr(my_esc);
  167.     quote := my_quote;
  168.     ctlset := [chr(1)..chr(31),chr(del),quote];
  169.     half_duplex := false;
  170.     debug := false;
  171.     emulating := false;
  172.     fwarn := false;
  173.     spsiz := max_pack;
  174.     rpsiz := max_pack;
  175.     n := 0;
  176.     parity := nopar;
  177.     initvocab;
  178.     fill_parity_array;
  179.     ibm := false;
  180.     xon := chr(17);
  181.     bufpos := 1;
  182.     bufend := 0;
  183.  
  184.     baud := defaultbaud;
  185.     setup_comm
  186.   end; (* initialize *)
  187.  
  188.  
  189. procedure closeup;
  190.  
  191.   begin
  192.     page( output )
  193.   end; (* closeup *)
  194.  
  195.  
  196.   begin (* main kermit program *)
  197.     initialize;
  198.     repeat
  199.         write('Kermit-UCSD> ');
  200.         readstr(keyport,line);
  201.         case parse of
  202.             unconfirmed: writeln('Unconfirmed');
  203.             parm_expected: writeln('Parameter expected');
  204.             ambiguous: writeln('Ambiguous');
  205.             unrec: writeln('Unrecognized command');
  206.             fn_expected: writeln('File name expected');
  207.             ch_expected: writeln('Single character expected');
  208.             null: case verb of
  209.                       consym: connect;
  210.                       helpsym: help;
  211.                       recsym: begin
  212.                           recsw(rec_ok);
  213.                           gotoxy(0,debugline);
  214.                           write(chr(bell));
  215.                           if rec_ok then
  216.                               writeln('successful receive')
  217.                           else
  218.                               writeln('unsuccessful receive');
  219.                           (*$I-*) (* set i/o checking off *)
  220.                           close(oldf);        { why??? }
  221.                           if not rec_ok then
  222.                              close(f);  { added by SP }
  223.                           (*$I+*) (* set i/o checking back on *)
  224.                           gotoxy(0,promptline);
  225.                         end; (* recsym *)
  226.                       sendsym: begin
  227.                           uppercase(xfilename);
  228.                           sendsw(send_ok);
  229.                           gotoxy(0,debugline);
  230.                           write(chr(bell));
  231.                           if send_ok then
  232.                               writeln('successful send')
  233.                           else
  234.                               writeln('unsuccessful send');
  235.                           (*$I-*) (* set i/o checking off *)
  236.                           close(oldf);
  237.                           (*$I+*) (* set i/o checking back on *)
  238.                           gotoxy(0,promptline);
  239.                         end; (* sendsym *)
  240.                       setsym: set_parms;
  241.                       show_sym: show_parms;
  242.                   end; (* case verb *)
  243.         end; (* case parse *)
  244.      until (verb = exitsym) or (verb = quitsym);
  245.      closeup
  246.    end. (* kermit *)
  247.