program kermit; UCSD Pascal KERMIT for the Terak p-System, from Kate MacGregor, Cornell U Adapted to Pascal Microengine by Tim Shimeall, UCI {Changes: - Added device declarations copied from Microengine hardware documentation - Replaced external assembly language routines with Pascal versions - Modified debug messages to be label values printed - Changed format of packetwrite display to show header fields - Implemented machine-dependent packet timeout - Added debug packetwrites in recsw - Added wrap-around debug info region - Added legality check in showparms - Removed lf elimination check in echo procedure - Unitwrite calls replaced by calls to device driving routines - Most uses of char_int_rec replaced by ord and chr - Removed queue (no interrupts) - Used sets for integer ops to getaround Microengine bug - Changed parser from a unit to a segment procedure to allow swapping - Split utility procs into separate files for editing and transfer convinience } {Adapted to Joyce Loebl's Magiscan 2 Image processing computer, by Henry Balen, Lancaster University } {Changes: - added ability for the parser to recognize digits, this enabled a Baudrate command to be implemented - added a command to set a work disk, set disk #. - The IO subroutines were put into an unit RS232 and changed to suit the Magiscan. - put the parser back into an unit since the Magiscan has 128K available. - modified the constants for the screen because the Magiscan only has 64 columns. - Added a unit SysUnit to enable the user to interogate the current work disk and delete files if so wishes. - Added a unit FileHandle which gives routines for accessing files for reading and writing, the old version of this didn't close a file if there was an unsuccessful receive/send this is now fixed. - Modified the Buffer empty and fill routines to use these. - Added the ability to do eight bit prefixing and the necessary routines for this. - Have added a new command called TRANSFER ( do a TRANSFER TYPE ), which enables transfers of image,data,code and text 'types'. - There is also image LOAD routine implemented, this allows the images to be loaded from disk and transfered to the Host straight from image memory. } Futher changes by H Balen, now of Joyce Loebl, March 1986 { - The receive packet routine has been put in the magiscan's microcode, data can now be succesfully received and transmitted at 9600 baud (except images ! max =4800 ), though the screen cannot scroll fast enough for incoming characters greater than 1200. - Two new options have been included - they are the MUX delay which tells the Magiscan how many cycles the wait when sending characters, and the option of using the winchester on #9. } (*$R-*) (* turn range checking off *) (*$S+*) (* turn swapping on *) (* $L PRINTER: *) (* no listing *) Uses M2Types,M2IpRoot,M2Sys, (*$U DISK.CODE*)DiskUnit, (*$U RS232.Code*)RS232, (*$U SysUnit.Code*)SysUnit, (*$U ParUnit.Code*)ParseUnit, (*$U FileUnit.Code*)FileHandle, (*$U HANDLE.CODE*)HANDLER; { the microcode } const blksize = 512; oport = 8; (* output port # *) (* clearscreen = 12; charcter which erases screen *) { bell = 7; } (* ASCII bell *) esc = 27; (* ASCII escape *) maxpack = 93; (* maximum packet size minus 1 *) soh = 1; (* start of header *) sp = 32; (* ASCII space *) cr = 13; (* ASCII CR *) lf = 10; (* ASCII line feed *) dle = 16; (* ASCII DLE (space compression prefix for psystem) *) del = 127; (* delete *) my_esc = 29; (* default esc char for connect (^]) *) maxtry = 5; (* number of times to retry sending packet *) my_quote = '#'; (* quote character I'll use *) my_bquote = '&'; { binary quate character I'll use } my_pad = 0; (* number of padding chars I need *) my_pchar = 0; (* padding character I need *) my_eol = 13; (* end of line character i need *) my_time = 5; (* seconds after which I should be timed out *) maxtim = 20; (* maximum timeout interval *) mintim = 2; (* minimum time out interval *) at_eof = -1; (* value to return if at eof *) eoln_sym = 13; (* pascal eoln sym *) back_space = 8; (* pascal backspace sym *) (* screen control information *) (* console line on which to put specified info *) title_line = 1; statusline = 2; packet_line = 3; retry_line = 4; file_line = 5; error_line = 6; prompt_line = 7; debug_line = 9; debug_max = 12; (* Max lines of debug to show at once *) (* position on line to put info *) statuspos = 54; packet_pos = 19; retry_pos = 17; file_pos = 11; Intsize = 15; type packettype = packed array[0..maxpack] of char; parity_type = (evenpar, oddpar, markpar, spacepar, nopar); char_int_rec = record (* allows character to be treated as integer... *) (* is system dependent *) case boolean of true: (i: integer); false: (ch: char) end; (* record *) int_bool_rec = record (* allows integer to be treated as boolean... *) (* used for numeric AND,OR,XOR...system dependent *) (* replaced by set version to escape microengine bug *) case boolean of true: (i: integer); false: (b: set of 0..intsize); end; (* record *) Port = (Terminal,Modem); var state: char; (* current state *) s: string; eol, bquote, quote, esc_char: char; fwarn, ibm, half_duplex, debug: boolean; delay, i, size, rpsiz, spsiz, pad, n, num_try, oldtry, timint: integer; recpkt, packet: packettype; padchar, ch: char; debf: text; (* file for debug output *) debnext:0..7; (* offset for next debug message *) parity: parity_type; xon: char; vol, Baud: integer; parity_array: packed array[char] of char; ctlset: set of char; rec_ok, send_ok: boolean; function read_ch(p: port; var ch: char): boolean; forward; function aand(x,y: integer): integer; forward; function aor(x,y: integer): integer; forward; function xor(x,y: integer): integer; forward; procedure error(p: packettype; len: integer); forward; procedure ino_error(i: integer); forward; procedure debugwrite(s: string); forward; procedure debugint(s: string; i: integer); forward; procedure writescreen(s: string); forward; procedure refresh_screen(numtry, num: integer); forward; function min(x,y: integer): integer; forward; function tochar(ch: char): char; forward; function unchar(ch: char): char; forward; function ctl(ch: char): char; forward; function getfil(filename: string): boolean; forward; procedure Bbufemp(buffer: packettype; len: integer); forward; function Bbufill(var buffer: packettype): integer; forward; procedure bufemp(buffer: packettype; var f: text; len: integer); forward; function bufill(var buffer: packettype): integer; forward; procedure spar(var packet: packettype); forward; procedure rpar(var packet: packettype); forward; procedure spack(ptype: char; num:integer; len: integer; data: packettype); forward; function getch(var r: char; p: port): boolean; forward; function getsoh(p: port): boolean; forward; function rpack(var len, num: integer; var data: packettype): char; forward; procedure read_str(p: port; var s: string); forward; procedure packetwrite(p: packettype; len: integer); forward; procedure show_parms; forward; (*$I HELP.TEXT*) (* Segment Procedure Help *) (*$I SENDSW.TEXT*) (* Segment Procedure Sendsw *) (*$I RECSW.TEXT*) (* Segment Procedure Recsw *) (*$I UTILS.TEXT *) (* General Utility procedures *) (*$I BINUTILS.TEXT*) { Routines for Binary transfer } (*$I RSUTILS.TEXT *) (* Utility procedures for send and receive *) procedure connect; (* connect to remote host (terminal emulation *) var ch: char; close: boolean; procedure read_esc; (* read charcter after esc char and interpret it *) begin repeat until read_ch(terminal,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','D','?'] then begin writeln; 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 *) 'D':begin vol := ord(disk[2]) - ord('0'); if vol in [9,10] then writeln('Cannot DIR a Winchester') else PrintNames(vol,value) end; (* D *) '?': begin (* ?: show options *) (* writeln('B Send a BREAK signal.'); *) writeln('C Close Connection, return to '); writeln(' KERMIT-UCSD command level.'); writeln('S Show Status of connection'); writeln('D displays the current directory'); writeln('? Print this list'); write('^',ctl(esc_char),' send the escape '); writeln('character itself to the'); writeln(' remote host.'); end; (* ? *) end (* case *) end else if ch = esc_char then (* ESC-char: send it out *) begin if half_duplex then begin echo(ch); while not istbtr do; sndbbt(ch); end (* if *) end (* else if *) else (* anything else: ignore *) write(chr(bell)) end; (* read_esc *) begin (* connect *) writeln('Connecting to host...type CTRL-',ctl(esc_char),' C to exit'); close := false; repeat if read_ch(modem,ch) then (* if char from host then *) echo(ch); (* echo it *) if read_ch(terminal,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 *) echo(ch); while not istbtr do; sndbbt(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: begin 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 (* count the 1's *) begin 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 *) end; (* case even *) oddpar: begin 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 (* count the 1's *) begin 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 *) end; (* 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 w/parity bit at all *) parity_array[ch] := ch; end; (* case *) end; (* fill_parity_array *) procedure write_bool(s: string; b: boolean); (* writes message & 'on' if b, 'off' if not b *) begin write(s); case b of true: writeln('on'); false: writeln('off'); end; (* case *) end; (* write_bool *) procedure writeTrans; writes the transfer state begin write('Transfer Type : '); case TranState of CodeFile : writeln('BINARY'); ImgFile : writeln('IMAGE'); TxtFile : writeln('TEXT'); "BinFile : writeln('DATA') end end{writeTrans}; procedure show_parms; (* shows the various settable parameters *) begin writeln; if noun in [allsym, debugsym, ibmsym, escsym, filewarnsym, muxsym, transym, disksym, localsym, baudsym, paritysym] then case noun of allsym: begin write_bool('Debugging is ',debug); writeln('Escape character is ^',ctl(esc_char)); write_bool('File warning is ',fwarn); write_bool('IBM is ',ibm); write_bool('Local echo is ',halfduplex); case parity of evenpar: write('Even'); markpar: write('Mark'); nopar: write('No'); oddpar: write('Odd'); spacepar: write('Space'); end; (* case *) writeln(' parity'); writeln('Baudrate is ',Baud); writeln('Drive is ',disk); writeln('MUX is ',MUXDelay); writetrans end; (* allsym *) debugsym: write_bool('Debugging is ',debug); escsym: writeln('Escape character is ^',ctl(esc_char)); filewarnsym: write_bool('File warning is ',fwarn); ibmsym: write_bool('IBM is ',ibm); localsym: write_bool('Local echo is ',halfduplex); baudsym : writeln('Baudrate is ',Baud); disksym : writeln('Drive is ',disk); transym : writetrans; muxsym : writeln('MUX is ',MUXDelay); paritysym: begin case parity of evenpar: write('Even'); markpar: write('Mark'); nopar: write('No'); oddpar: write('Odd'); end; writeln(' parity'); end; (* paritysym *) typesym : writetrans end (* case *) else write(chr(bell)); end; (* show_sym *) procedure set_parms; (* sets the parameters *) begin case noun of debugsym: case adj of onsym: begin debug := true; (*$I-*) rewrite(debf,'CONSOLE:') (*I+*) end; (* onsym *) offsym: debug := false end; (* case adj *) escsym: escchar := newescchar; filewarnsym: fwarn := (adj = onsym); ibmsym: case adj of onsym: begin ibm := true; parity := markpar; half_duplex := true; fillparityarray end; (* onsym *) offsym: begin ibm := false; parity := nopar; half_duplex := false; fillparityarray end; (* onsym *) end; (* case adj *) localsym: halfduplex := (adj = onsym); paritysym: begin case adj of evensym: parity := evenpar; marksym: parity := markpar; nonesym: parity := nopar; oddsym: parity := oddpar; spacesym: parity := spacepar; end; (* case *) fill_parity_array; end; (* paritysym *) MUXsym : begin MUXDelay := value end (* baudsym *); baudsym : begin Baud := value; BaudRate(Baud) end (* baudsym *); disksym : begin if value in [4,5,9] then begin disk := ' '; disk[1] := chr(ord('0')+value); disk := concat('#',disk); disk := concat(disk,':') end else writeln('Drive does not exist ') end (* disksym *) end; (* case *) end; (* set_parms *) procedure initialize; var ch: char; begin pad := mypad; padchar := chr(mypchar); eol := chr(my_eol); esc_char := chr(my_esc); quote := my_quote; bquote := my_bquote; ctlset := [chr(1)..chr(31),chr(del),quote,bquote]; TranState := TxtFile; TimInt := My_Time; half_duplex := false; debug := false; debnext:=0; fwarn := false; spsiz := max_pack; rpsiz := max_pack; n := 0; parity := nopar; initvocab; fill_parity_array; ibm := false; xon := chr(17); {bufpos := 1;} initM; Baud := 1200; FileInit; value := 0; disk := '#5:' end; (* initialize *) procedure closeup; begin writeln(chr(ff){clearscreen}); end; (* closeup *) begin (* kermit *) initialize; { Load in the microcode } OVLYLOAD('HANDLE'); repeat write('Kermit-UCSD> '); readstr(terminal,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; Loadsym: begin uppercase(filename); LoadIm(filename) end; recsym: begin recsw(rec_ok); gotoxy(0,debugline); write(chr(bell)); if rec_ok then writeln('successful receive') else writeln('unsuccessful receive'); gotoxy(0,promptline); end; (* recsym *) sendsym: begin uppercase(filename); 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 *) closeF(filename,False); (*$I+*) (* set i/o checking back on *) gotoxy(0,promptline); end; (* sendsym *) delsym: begin uppercase(filename); vol := ord(disk[2]) - ord('0'); Delfile(filename,vol) end; (* delsym *) setsym: set_parms; transym: begin if noun = Typesym then case adj of binsym : TranState := CodeFile; datasym : TranState := BinFile; textsym : TranState := TxtFile; imagesym : TranState := ImgFile; end else write(Bell) end; show_sym: show_parms; dirsym : begin vol := ord(disk[2]) - ord('0'); if vol in [9,10] then writeln('Cannot DIR a Winchester') else PrintNames(vol,value) end (* dirsym *) end; (* case verb *) end; (* case parse *) { unitclear(1); }(* clear any trash in input *) { unitclear(2); } (* Don't clear the screen ! *) until (verb = exitsym) or (verb = quitsym); closeup end.(* kermit *)