home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pub / ucsdwdme / kermit.text < prev    next >
Text File  |  2020-01-01  |  19KB  |  565 lines

  1. program kermit;
  2. UCSD Pascal KERMIT for the Terak p-System, from Kate MacGregor, Cornell U
  3. Adapted to Pascal Microengine by Tim Shimeall, UCI
  4. {Changes:
  5. - Added device declarations copied from Microengine hardware documentation
  6. - Replaced external assembly language routines with Pascal versions
  7. - Modified debug messages to be label values printed
  8. - Changed format of packetwrite display to show header fields
  9. - Implemented machine-dependent packet timeout
  10. - Added debug packetwrites in recsw
  11. - Added wrap-around debug info region
  12. - Added legality check in showparms
  13. - Removed lf elimination check in echo procedure
  14. - Unitwrite calls replaced by calls to device driving routines
  15. - Most uses of char_int_rec replaced by ord and chr
  16. - Removed queue (no interrupts)
  17. - Used sets for integer ops to getaround Microengine bug
  18. - Changed parser from a unit to a segment procedure to allow swapping
  19. - Split utility procs into separate files for editing and transfer convinience
  20.  
  21. }
  22. (*$R-*) (* turn range checking off *)
  23. (*$S+*) (* turn swapping on *)
  24. (* $L+*) (* no listing *)
  25.  
  26. const blksize = 512;
  27.       oport = 8;          (* output port # *)
  28.       (* clearscreen = 12;   charcter which erases screen *)
  29.       bell = 7;           (* ASCII bell *)
  30.       esc = 27;           (* ASCII escape *)
  31.       maxpack = 93;       (* maximum packet size minus 1 *)
  32.       soh = 1;            (* start of header *)
  33.       sp = 32;            (* ASCII space *)
  34.       cr = 13;            (* ASCII CR *)
  35.       lf = 10;            (* ASCII line feed *)
  36.       dle = 16;           (* ASCII DLE (space compression prefix for psystem) *)
  37.       del = 127;          (* delete *)
  38.       my_esc = 29;        (* default esc char for connect (^]) *)
  39.       maxtry = 5;         (* number of times to retry sending packet *)
  40.       my_quote = '#';     (* quote character I'll use *)
  41.       my_pad = 0;         (* number of padding chars I need *)
  42.       my_pchar = 0;       (* padding character I need *)
  43.       my_eol = 13;        (* end of line character i need *)
  44.       my_time = 5;        (* seconds after which I should be timed out *)
  45.       maxtim = 20;        (* maximum timeout interval *)
  46.       mintim = 2;         (* minimum time out interval *)
  47.       at_eof = -1;        (* value to return if at eof *)
  48.       eoln_sym = 13;      (* pascal eoln sym *)
  49.       back_space = 8;     (* pascal backspace sym *)
  50.  
  51. (* MICROENGINE dependent constants *)
  52.       intsize = 15;       (* number of bits in an integer minus 1 *)
  53.       Channel0=-992; {FC20 = serial Port B register}
  54.       Channel1=-1008; {FC10 = serial Port A register}
  55.      (* Elements of the status vector in the "StatCmdRec" declared below*)
  56.       RegEmpty=0;
  57.       DataReceived=1;
  58.       OverError=2;
  59.       FrameError=4;
  60.      (* bits 3,5,6,and 7 are not used, since they rely on specific wiring,
  61.        and seem to be unreliable *)
  62.  
  63. (* screen control information *)
  64.   (* console line on which to put specified info *)
  65.       title_line = 1;
  66.       statusline = 2;
  67.       packet_line = 3;
  68.       retry_line = 4;
  69.       file_line = 5;
  70.       error_line = 6;
  71.       prompt_line = 7;
  72.       debug_line = 9;
  73.       debug_max = 12; (* Max lines of debug to show at once *)
  74.   (* position on line to put info *)
  75.       statuspos = 70;
  76.       packet_pos = 19;
  77.       retry_pos = 17;
  78.       file_pos = 11;
  79.  
  80. type packettype = packed array[0..maxpack] of char;
  81.      parity_type = (evenpar, oddpar, markpar, spacepar, nopar);
  82.  
  83.      char_int_rec = record (* allows character to be treated as integer... *)
  84.                            (* is system dependent *)
  85.                       case boolean of
  86.                           true: (i: integer);
  87.                           false: (ch: char)
  88.                     end; (* record *)
  89.  
  90.      int_bool_rec = record (* allows integer to be treated as boolean... *)
  91.                            (* used for numeric AND,OR,XOR...system dependent *)
  92.                            (* replaced by set version to escape microengine
  93.                               bug *)
  94.                       case boolean of
  95.                           true: (i: integer);
  96.                           false: (b: set of 0..intsize);
  97.                     end; (* record *)
  98.  
  99. (* MICROENGINE Dependent Types *)
  100.      Port = (Terminal,Modem);
  101.      Statcmdrec = RECORD CASE BOOLEAN OF  (* Only the Status field is used
  102.                                              in this code, but the declaration
  103.                                              is from Western Digital doc. *)
  104.                     TRUE:(Command:INTEGER);
  105.                     FALSE:(Status:PACKED ARRAY [0:7] OF BOOLEAN);
  106.                     END;
  107.     SerialRec = RECORD
  108.                  SerData:INTEGER;
  109.                  StatSynDle:StatCmdRec;
  110.                  Control2:INTEGER;
  111.                  Control1:INTEGER;
  112.                  filler:ARRAY [0..3] OF INTEGER;
  113.                  Switch:StatCmdRec;
  114.                  END;
  115.  
  116.    (* Parser Types *)
  117.      statustype = (null, at_eol, unconfirmed, parm_expected, ambiguous,
  118.                    unrec, fn_expected, ch_expected);
  119.      vocab = (nullsym, allsym, consym, debugsym, escsym, evensym, exitsym,
  120.               filewarnsym,helpsym, ibmsym, localsym, marksym, nonesym,
  121.               oddsym, offsym, onsym, paritysym, quitsym, recsym, sendsym,
  122.               setsym, showsym, spacesym);
  123.  
  124. var state: char; (* current state *)
  125.     f: file of char; (* file to be received *)
  126.     oldf: file; (* file to be sent *)
  127.     s: string;
  128.     eol, quote, esc_char: char;
  129.     fwarn, ibm, half_duplex, debug: boolean;
  130.     i, size, rpsiz, spsiz, pad, n, num_try, oldtry, timint: integer;
  131.     recpkt, packet: packettype;
  132.     padchar, ch: char;
  133.     debf: text; (* file for debug output *)
  134.     debnext:0..7; (* offset for next debug message *)
  135.     parity: parity_type;
  136.     xon: char;
  137.     filebuf: packed array[1..1024] of char;
  138.     bufpos, bufend: integer;
  139.     parity_array: packed array[char] of char;
  140.     ctlset: set of char;
  141.     rec_ok, send_ok: boolean;
  142.  
  143. (* MICROENGINE Dependent Variable declarations *)
  144.      PortA,PortB:RECORD CASE BOOLEAN OF
  145.                 TRUE:(DevAdd:INTEGER);
  146.                 FALSE:(Serial:^SerialRec);
  147.                 END;
  148.    (* Parser vars *)
  149.  
  150.     noun, verb, adj: vocab;
  151.     status: statustype;
  152.     vocablist: array[vocab] of string[13];
  153.     filename, line: string;
  154.     newescchar: char;
  155.     expected: set of vocab;
  156.  
  157. function read_ch(p: port; var ch: char): boolean;
  158. forward;
  159.  
  160. function aand(x,y: integer): integer;
  161. forward;
  162.  
  163. function aor(x,y: integer): integer;
  164. forward;
  165.  
  166. function xor(x,y: integer): integer;
  167. forward;
  168.  
  169. procedure error(p: packettype; len: integer);
  170. forward;
  171.  
  172. procedure io_error(i: integer);
  173. forward;
  174.  
  175. procedure debugwrite(s: string);
  176. forward;
  177.  
  178. procedure debugint(s: string; i: integer);
  179. forward;
  180.  
  181. procedure writescreen(s: string);
  182. forward;
  183.  
  184. procedure refresh_screen(numtry, num: integer);
  185. forward;
  186.  
  187. function min(x,y: integer): integer;
  188. forward;
  189.  
  190. function tochar(ch: char): char;
  191. forward;
  192.  
  193. function unchar(ch: char): char;
  194. forward;
  195.  
  196. function ctl(ch: char): char;
  197. forward;
  198.  
  199. function getfil(filename: string): boolean;
  200. forward;
  201.  
  202. procedure bufemp(buffer: packettype; var f: text; len: integer);
  203. forward;
  204.  
  205. function bufill(var buffer: packettype): integer;
  206. forward;
  207.  
  208. procedure spar(var packet: packettype);
  209. forward;
  210.  
  211. procedure rpar(var packet: packettype);
  212. forward;
  213.  
  214. procedure spack(ptype: char; num:integer; len: integer; data: packettype);
  215. forward;
  216.  
  217. function getch(var r: char; p: port): boolean;
  218. forward;
  219.  
  220. function getsoh(p: port): boolean;
  221. forward;
  222.  
  223. function rpack(var len, num: integer; var data: packettype): char;
  224. forward;
  225.  
  226. procedure read_str(p: port; var s: string);
  227. forward;
  228.  
  229. procedure packetwrite(p: packettype; len: integer);
  230. forward;
  231.  
  232. procedure show_parms;
  233. forward;
  234.  
  235. procedure uppercase(var s: string); forward;
  236.  
  237.  
  238. (*$I WDFORW.TEXT *) (* Forward Declarations for WDPROCS.TEXT *)
  239. (*$I HELP.TEXT*) (* Segment Procedure Help *)
  240. (*$I SENDSW.TEXT*) (* Segment Procedure Sendsw *)
  241. (*$I RECSW.TEXT*) (* Segment Procedure Recsw *)
  242. (*$I PARSE.TEXT*) (* Segment Function Parse *)
  243. (*$I WDPROCS.TEXT*) (* MICROENGINE dependent routines*)
  244. (*$I UTILS.TEXT *) (* General Utility procedures *)
  245. (*$I RSUTILS.TEXT *) (* Utility procedures for send and receive *)
  246.  
  247. procedure connect;
  248.  
  249. (* connect to remote host (terminal emulation *)
  250.  
  251. var ch: char;
  252.     close: boolean;
  253.  
  254.   procedure read_esc;
  255.  
  256.   (* read charcter after esc char and interpret it *)
  257.  
  258.     begin
  259.       repeat
  260.       until read_ch(terminal,ch);       (* wait until they've typed something in *)
  261.       if (ch in ['a'..'z']) then  (* uppercase it *)
  262.           ch := chr(ord(ch) - ord('a') + ord('A'));
  263.       if ch in [{'B',}'C','S','?'] then
  264.           case ch of
  265.               (*'B': sendbrk;        B: send a break to the IBM *)
  266.               'C': close := true; (* C: end connection *)
  267.               'S': begin          (* S: show status *)
  268.                   noun := allsym;
  269.                   showparms
  270.                 end; (* S *)
  271.               '?': begin          (* ?: show options *)
  272.                   (* writeln('B    Send a BREAK signal.'); *)
  273.                   write('C    Close Connection, return to ');
  274.                   writeln('KERMIT-UCSD command level.');
  275.                   writeln('S    Show Status of connection');
  276.                   writeln('?    Print this list');
  277.                   write('^',esc_char,'   send the escape ');
  278.                   writeln('character itself to the');
  279.                   writeln('     remote host.')
  280.                 end; (* ? *)
  281.             end (* case *)
  282.       else if ch = esc_char then  (* ESC-char: send it out *)
  283.         begin
  284.           if half_duplex then
  285.             begin
  286.               echo(ch);
  287.               while not istbtr do;
  288.               sndbbt(ch);
  289.             end (* if *)
  290.         end (* else if *)
  291.       else                        (* anything else: ignore *)
  292.           write(chr(bell))
  293.     end; (* read_esc *)
  294.  
  295.   begin (* connect *)
  296.     writeln('Connecting to host...type CTRL-',ctl(esc_char),' C to exit');
  297.     close := false;
  298.     repeat
  299.         if read_ch(modem,ch) then        (* if char from host then *)
  300.             echo(ch);                   (* echo it *)
  301.  
  302.         if read_ch(terminal,ch) then        (* if char from keyboard then *)
  303.             if ch <> esc_char then      (* if not ESC-char then *)
  304.               begin
  305.                 if half_duplex then       (* echo it if half-duplex *)
  306.                     echo(ch);
  307.                 while not istbtr do;
  308.                 sndbbt(ch)               (* send it out the port *)
  309.               end (* if *)
  310.             else (* ch = esc_char *)    (* else is ESC-char so *)
  311.               read_esc;                   (* interpret next char *)
  312.     until close;                      (* if still connected, get more *)
  313.     writeln('Disconnected')
  314.   end; (* connect *)
  315.  
  316. procedure fill_parity_array;
  317.  
  318. (* parity value table for even parity...not(entry) = odd parity *)
  319.  
  320. const min = 0;
  321.       max = 126;
  322.  
  323. var i, shifter, counter: integer;
  324.     minch, maxch, ch: char;
  325.     r: char_int_rec;
  326.  
  327.   begin
  328.     minch := chr(min);
  329.     maxch := chr(max);
  330.     case parity of
  331.       evenpar:
  332.         begin
  333.           for ch := minch to maxch do
  334.             begin
  335.               r.ch := ch;               (* put char into variant record *)
  336.               shifter := aand(r.i,255); (* mask off parity bit *)
  337.               counter := 0;
  338.               for i := 1 to 7 do        (* count the 1's *)
  339.                 begin
  340.                   if odd(shifter) then
  341.                       counter := counter + 1;
  342.                   shifter := shifter div 2
  343.                 end; (* for i *)
  344.               if odd(counter) then       (* stick a 1 on if necessary *)
  345.                   parity_array[ch] := chr(aor(ord(ch),128))
  346.               else
  347.                   parity_array[ch] := chr(aand(ord(ch),127))
  348.             end; (* for ch *)
  349.         end; (* case even *)
  350.       oddpar:
  351.         begin
  352.           for ch := minch to maxch do
  353.             begin
  354.               r.ch := ch;                (* put char into variant record *)
  355.               shifter := aand(r.i,255);  (* mask off parity bit *)
  356.               counter := 0;
  357.               for i := 1 to 7 do         (* count the 1's *)
  358.                 begin
  359.                   if odd(shifter) then
  360.                       counter := counter + 1;
  361.                   shifter := shifter div 2
  362.                 end; (* for i *)
  363.               if odd(counter) then        (* stick a 1 on if necessary *)
  364.                   parity_array[ch] := chr(aand(ord(ch),127))
  365.               else
  366.                   parity_array[ch] := chr(aor(ord(ch),128))
  367.             end; (* for ch *)
  368.         end; (* case odd *)
  369.       markpar:
  370.           for ch := minch to maxch do     (* stick a 1 on all chars *)
  371.               parity_array[ch] := chr(aor(ord(ch),128));
  372.       spacepar:
  373.           for ch := minch to maxch do     (* mask off parity on all chars *)
  374.               parity_array[ch] := chr(aand(ord(ch),127));
  375.       nopar:
  376.           for ch := minch to maxch do     (* don't mess w/parity bit at all *)
  377.               parity_array[ch] := ch;
  378.     end; (* case *)
  379.   end; (* fill_parity_array *)
  380.  
  381. procedure write_bool(s: string; b: boolean);
  382.  
  383. (* writes message & 'on' if b, 'off' if not b *)
  384.   begin
  385.     write(s);
  386.     case b of
  387.         true: writeln('on');
  388.         false: writeln('off');
  389.       end; (* case *)
  390.   end; (* write_bool *)
  391.  
  392. procedure show_parms;
  393.  
  394. (* shows the various settable parameters *)
  395.  
  396.   begin
  397.     if noun in [allsym, debugsym, ibmsym, escsym, filewarnsym, localsym,
  398.                 paritysym] then
  399.     case noun of
  400.         allsym:
  401.           begin
  402.             write_bool('Debugging is ',debug);
  403.             writeln('Escape character is ^',ctl(esc_char));
  404.             write_bool('File warning is ',fwarn);
  405.             write_bool('IBM is ',ibm);
  406.             write_bool('Local echo is ',halfduplex);
  407.             case parity of
  408.                 evenpar: write('Even');
  409.                 markpar: write('Mark');
  410.                 nopar: write('No');
  411.                 oddpar: write('Odd');
  412.                 spacepar: write('Space');
  413.               end; (* case *)
  414.             writeln(' parity');
  415.           end; (* allsym *)
  416.         debugsym: write_bool('Debugging is ',debug);
  417.         escsym: writeln('Escape character is ^',ctl(esc_char));
  418.         filewarnsym: write_bool('File warning is ',fwarn);
  419.         ibmsym: write_bool('IBM is ',ibm);
  420.         localsym: write_bool('Local echo is ',halfduplex);
  421.         paritysym: begin
  422.             case parity of
  423.                 evenpar: write('Even');
  424.                 markpar: write('Mark');
  425.                 nopar: write('No');
  426.                 oddpar: write('Odd');
  427.             (' parity');
  428.            end; (* paritysym *)
  429.       end (* case *)
  430.       else write(chr(bell));
  431.   end; (* show_sym *)
  432.  
  433. procedure set_parms;
  434.  
  435. (* sets the parameters *)
  436.  
  437.   begin
  438.     case noun of
  439.         debugsym: case adj of
  440.                       onsym: begin
  441.                           debug := true;
  442.                           (*$I-*)
  443.                           rewrite(debf,'CONSOLE:')
  444.                           (*I+*)
  445.                         end; (* onsym *)
  446.                       offsym: debug := false
  447.                     end; (* case adj *)
  448.         escsym: escchar := newescchar;
  449.         filewarnsym: fwarn := (adj = onsym);
  450.         ibmsym: case adj of
  451.                     onsym: begin
  452.                         ibm := true;
  453.                         parity := markpar;
  454.                         half_duplex := true;
  455.                         fillparityarray
  456.                       end; (* onsym *)
  457.                     offsym: begin
  458.                         ibm := false;
  459.                         parity := nopar;
  460.                         half_duplex := false;
  461.                         fillparityarray
  462.                       end; (* onsym *)
  463.                   end; (* case adj *)
  464.         localsym: halfduplex := (adj = onsym);
  465.         paritysym: begin
  466.               case adj of
  467.                   evensym: parity := evenpar;
  468.                   marksym: parity := markpar;
  469.                   nonesym: parity := nopar;
  470.                   oddsym: parity := oddpar;
  471.                   spacesym: parity := spacepar;
  472.                 end; (* case *)
  473.               fill_parity_array;
  474.              end; (* paritysym *)
  475.       end; (* case *)
  476.   end; (* set_parms *)
  477.  
  478. procedure initialize;
  479.  
  480. var ch: char;
  481.  
  482.   begin
  483.     pad := mypad;
  484.     padchar := chr(mypchar);
  485.     eol := chr(my_eol);
  486.     esc_char := chr(my_esc);
  487.     quote := my_quote;
  488.     ctlset := [chr(1)..chr(31),chr(del),quote];
  489.     half_duplex := false;
  490.     debug := false;
  491.     debnext:=0;
  492.     fwarn := false;
  493.     spsiz := max_pack;
  494.     rpsiz := max_pack;
  495.     n := 0;
  496.     parity := nopar;
  497.     initvocab;
  498.     fill_parity_array;
  499.     ibm := false;
  500.     xon := chr(17);
  501.     bufpos := 1;
  502.     bufend := 0;
  503.     init;
  504.   end; (* initialize *)
  505.  
  506. procedure closeup;
  507.  
  508.   begin
  509.     finit;
  510.     writeln(chr(esc),'E'{clearscreen});
  511.   end; (* closeup *)
  512.  
  513.   begin (* kermit *)
  514.     initialize;
  515.     repeat
  516.         write('Kermit-UCSD> ');
  517.         readstr(terminal,line);
  518.         case parse of
  519.             unconfirmed: writeln('Unconfirmed');
  520.             parm_expected: writeln('Parameter expected');
  521.             ambiguous: writeln('Ambiguous');
  522.             unrec: writeln('Unrecognized command');
  523.             fn_expected: writeln('File name expected');
  524.             ch_expected: writeln('Single character expected');
  525.             null: case verb of
  526.                       consym: connect;
  527.                       helpsym: help;
  528.                       recsym: begin
  529.                           recsw(rec_ok);
  530.                           gotoxy(0,debugline);
  531.                           write(chr(bell));
  532.                           if rec_ok then
  533.                               writeln('successful receive')
  534.                           else
  535.                               writeln('unsuccessful receive');
  536.                           (*$I-*) (* set i/o checking off *)
  537.                           close(oldf);
  538.                           (*$I+*) (* set i/o checking back on *)
  539.                           gotoxy(0,promptline);
  540.                         end; (* recsym *)
  541.                       sendsym: begin
  542.                           uppercase(filename);
  543.                           sendsw(send_ok);
  544.                           gotoxy(0,debugline);
  545.                           write(chr(bell));
  546.                           if send_ok then
  547.                               writeln('successful send')
  548.                           else
  549.                               writeln('unsuccessful send');
  550.                           (*$I-*) (* set i/o checking off *)
  551.                           close(oldf);
  552.                           (*$I+*) (* set i/o checking back on *)
  553.                           gotoxy(0,promptline);
  554.                         end; (* sendsym *)
  555.                       setsym: set_parms;
  556.                       show_sym: show_parms;
  557.                   end; (* case verb *)
  558.         end; (* case parse *)
  559.         unitclear(1); (* clear any trash in input *)
  560.         unitclear(2);
  561.      until (verb = exitsym) or (verb = quitsym);
  562.      closeup
  563.    end. (* kermit *)
  564.  
  565.