function getfil(*filename: string): boolean*);

(* opens a file for writing *)

  begin
    (*$I-*) (* turn i/o checking off *)
    rewrite(f,filename);
    (*$I-*) (* turn i/o checking on *)
    getfil := (ioresult = 0)
  end; (* getfil *)

procedure bufemp(*buffer: packettype; var f: text; len: integer*);

(* empties a packet into a file *)

var i,ls: integer;
    r: char;
    s: string;

  begin
    s := copy('',0,0);
    ls := 0;
    i := 0;
    while i < len do
      begin
        r := buffer[i];          (* get a character *)
        if (r = myquote) then    (* if character is control quote *)
          begin
            i := i + 1;               (* skip over quote and *)
            r := buffer[i];        (* get quoted character *)
            if (aand(ord(r),127) <> ord(myquote)) then
                r := ctl(r);       (* controllify it *)
          end; (* if *)
        if (ord(r) = cr) then          (* else if a carriage return then *)
          begin
            i := i + 3;               (* skip over that and line feed *)
            (*$I-*)                   (* turn i/o checking off *)
            writeln(f,s);             (* and write out line to file *)
            s := copy('',0,0);        (* empty the string var *)
            ls := 0;
            if (io_result <> 0) then  (* if io_error *)
              begin
                io_error(ioresult);     (* tell them and *)
                state := 'a';           (* abort *)
              end (* if *)
          end
      (*$I+*)                      (* turn i/o checking back on *)
      else                        (* else, is a regular char, so *)
          begin
            r:= chr(aand(ord(r),127));     (* mask off parity bit *)
            s := concat(s,' ');       (* and add character to out string *)
            ls := ls + 1;
            s[ls] := r;
            i := i + 1                (* increase buffer pointer *)
          end; (* else *)
      end; (* while *)              (* and get another char *)
      (*$I-*)                     (* turn i/o checking off *)
      write(f,s);                 (* and write out line to file *)
      if (io_result <> 0) then    (* if io_error *)
        begin
          io_error(ioresult);       (* tell them and *)
          state := 'a';             (* abort *)
        end (* if *)
      (*$I+*)                      (* turn i/o checking back on *)
  end; (* bufemp *)

function bufill(*var buffer: packettype): integer*);

(* fill a packet with data from a file...manages a 2 block buffer *)

var i, j, k, t7, count: integer;
    r: char;

  begin
    i := 0;
    (* while file has some data & packet has some room we'll keep going *)
    while ((bufpos <= bufend) or (not eof(oldf))) and (i < spsiz-9) do
      begin
        (* if we need more data from disk then *)
        if (bufpos > bufend) and (not eof(oldf)) then
          begin
            (* read a couple of blocks *)
            bufend := blockread(oldf,filebuf[1],2) * blksize;
            (* and adjust buffer pointer *)
            bufpos := 1
          end; (* if *)
        if (bufpos <= bufend) then     (* if we're within buffer bounds *)
          begin
            r := filebuf[bufpos];      (* get a character *)
            bufpos := bufpos + 1;         (* increase buffer pointer *)
            if (ord(r) = dle) then           (* if it's space compression char, *)
              begin
                count := ord(unchar(filebuf[bufpos])); (* get # of spaces *)
                bufpos := bufpos + 1;       (* read past # *)
                r := ' ';                (* and make current char a space *)
              end (* else if *)
            else                           (* otherwise, it's just a char *)
                count := 1;                (* so only 1 copy of it *)
            if (r in ctlset) then     (* if a control char *)
              begin
                if (ord(r) = cr) then         (* if a carriage return *)
                  begin
                    buffer[i] := quote;      (* put (quoted) CR in buffer *)
                    i := i + 1;
                    buffer[i] := ctl(chr(cr));
                    i := i + 1;
                    r := chr(lf);            (* and we'll stick a LF after *)
                  end; (* if *)
                if r <> chr(0) then          (* if not a NUL then *)
                  begin
                    buffer[i] := quote;      (* put the quote in buffer *)
                    i := i + 1;
                    if r <> quote then
                        r := ctl(r);   (* and un-controllify char *)
                  end (* if *)
              end; (* if *)
          end; (* if *)
        j := 1;
        while (j <= count) and (i <= spsiz - 5) do
          begin                           (* put all the chars in buffer *)
            if (ord(r) <> 0) then            (* so long as not a NUL *)
              begin
                buffer[i] := r;
                i := i + 1;
              end (* if *)
            else                          (* is a NUL so *)
                if (bufpos > blksize) then  (* skip to end of block *)
                    bufpos := bufend + 1    (* since rest will be NULs *)
                else
                    bufpos := blksize + 1;
            j := j + 1
          end; (* while *)
      end; (* while *)
    if (i = 0) then                         (* if we're at end of file, *)
        bufill := (at_eof)                    (* indicate it *)
    else                                    (* else *)
      begin
        if (j <= count) then                  (* if didn't all fit in packet *)
          begin
            bufpos := bufpos - 2;               (* put buf pointer at DLE *)
                                                (* and update compress count *)
            filebuf[bufpos + 1] := tochar(chr(count-j+1));
          end; (* if *)
        bufill := i                           (* return # of chars in packet *)
      end; (* else *)
  end; (* bufill *)

procedure spar(*var packet: packettype*);

(* fills data array with my send-init parameters *)

  begin
    packet[0] := tochar(chr(maxpack));   (* biggest packet i can receive *)
    packet[1] := tochar(chr(mytime));    (* when i want to be timed out *)
    packet[2] := tochar(chr(mypad));     (* how much padding i need *)
    packet[3] := ctl(chr(mypchar));      (* padding char i want *)
    packet[4] := tochar(chr(myeol));     (* end of line character i want *)
    packet[5] := myquote;                (* control-quote char i want *)
    packet[6] := 'N';                    (* I won't do 8-bit quoting *)
  end; (* spar *)

procedure rpar(*var packet: packettype*);

(* gets their init params *)
var s:string;
  begin
    s:='rpar:spsize:## timint:## pad:## padchar:### eol:### quote:###';
    spsiz := ord(unchar(packet[0]));     (* max send packet size *)
    s[13]:=chr(ord('0')+(spsiz div 10));
    s[14]:=chr(ord('0')+(spsiz mod 10));
    timint := ord(unchar(packet[1]));    (* when i should time out *)
    s[23]:=chr(ord('0')+(timint div 10));
    s[24]:=chr(ord('0')+(timint mod 10));
    pad := ord(unchar(packet[2]));       (* number of pads to send *)
    s[30]:=chr(ord('0')+(pad div 10));
    s[31]:=chr(ord('0')+(pad mod 10));
    padchar := ctl(packet[3]);           (* padding char to send *)
    s[41]:=chr(ord('0')+(ord(padchar) div 100));
    s[42]:=chr(ord('0')+((ord(padchar) mod 100) div 10));
    s[43]:=chr(ord('0')+(ord(padchar) mod 10));
    eol := unchar(packet[4]);            (* eol char i must send *)
    s[49]:=chr(ord('0')+(ord(eol) div 100));
    s[50]:=chr(ord('0')+((ord(eol) mod 100) div 10));
    s[51]:=chr(ord('0')+(ord(eol) mod 10));
    quote := packet[5];                  (* incoming data quote char *)
    s[59]:=chr(ord('0')+(ord(quote) div 100));
    s[60]:=chr(ord('0')+((ord(quote) mod 100) div 10));
    s[61]:=chr(ord('0')+(ord(quote) mod 10));
    debugwrite(s);
  end; (* rpar *)

procedure packetwrite(*p: packettype; len: integer*);

(* writes out all of a packet for debugging purposes *)

var i: integer;
    s: string;
  begin
    s:='length:## Sequence:## Type: #';
    if p[0]=chr(soh) then s:=concat('SOH ',s);
    s[8]:=chr(ord('0')+(ord(p[1]) div 10));
    s[9]:=chr(ord('0')+(ord(p[1]) mod 10));
    s[20]:=chr(ord('0')+(ord(p[2]) div 10));
    s[21]:=chr(ord('0')+(ord(p[2]) mod 10));
    s[length(s)]:=p[3];
    debugwrite(s);
    gotoxy(0,debugline+debnext);
    debnext:=(debnext+1) mod debug_max;
    for i := 4 to len+3 do
      begin
        if i = 84 then
          begin
            gotoxy(0,debugline+debnext);
            debnext:=(debnext+1) mod debug_max;
            write(chr(27),'K');
          end; (* if *)
        write(p[i])
      end; (* for *)
  end; (* packetwrite *)

procedure spack(*ptype: char; num: integer; len: integer; data: packettype*);

(* send a packet *)

const maxtry = 10000;

var bufp, i, count: integer;
    chksum: char;
    buffer: packettype;
    ch: char;

  begin
    if ibm and (state <> 's') then           (* if ibm and not SINIT then *)
      begin
        count := 0;
        repeat                                 (* wait for an xon *)
            repeat
                count := count + 1
            until (readch(modem,ch)) or (count > maxtry );
        until (ch = xon) or (count > maxtry);
        if count > maxtry then                 (* if wait too long then *)
          begin
            exit(spack)                          (* get out *)
          end; (* if *)
      end; (* if *)

    bufp := 0;
    for i := 1 to pad do begin
        while not istbtr do ;
        sndbbt(padchar);                     (* write out any padding chars *)
        end;
    buffer[bufp] := chr(soh);                (* packet sync character *)
    bufp := bufp + 1;
    chksum := tochar(chr(len + 3));          (* init chksum *)
    buffer[bufp] := tochar(chr(len + 3));    (* character count *)
    bufp := bufp + 1;
    chksum := chr(ord(chksum) + ord(tochar(chr(num))));
    buffer[bufp] := tochar(chr(num));
    bufp := bufp + 1;
    chksum := chr(ord(chksum) + ord(ptype));
    buffer[bufp] := ptype;                   (* packet type *)
    bufp := bufp + 1;

    for i := 0 to len - 1 do                 (* loop through data chars *)
      begin
        buffer[bufp] := data[i];             (* store char *)
        bufp := bufp + 1;
        chksum := chr(ord(chksum) + ord(data[i]))
      end; (* for i *)
                                             (* compute final chksum *)
    chksum := chr(aand(ord(chksum) + (aand(ord(chksum),192) div 64), 63));
    buffer[bufp] := tochar(chksum);
    bufp := bufp + 1;
    buffer[bufp] := eol;

    if (parity <> nopar) then
        for i := 0 to bufp do                 (* set correct parity on buffer *)
            buffer[i] := parity_array[buffer[i]];

    for i:=0 to bufp do begin
      while not istbtr do;
      sndbbt(buffer[i]);    (* send the packet out *)
      end;

    debugwrite('sending');
    if debug then
        packetwrite(buffer,len);
  end; (* spack *)

function getsoh(*p: port): boolean*);

(* reads characters until it finds an SOH; returns false if has to read more *)
(* than maxtry chars *)

const maxtry = 10000; (* allows about 1 second of trying *)

var ch: char;
    seconds,count: integer;

  begin
    count := 0;
    seconds:=0;
    get_soh := true;
    repeat
        repeat
            count := count + 1;
            if count>maxtry then begin
             seconds:=seconds+1;
             count:=0;
             end;
        until ready(p) or (seconds > timint); (* wait for a character *)
        if (seconds > timint) then
          begin
            get_soh := false;
            exit(get_soh);
          end;
        ch := pget(p);                           (* get the character *)
        ch := chr(aand(ord(ch),127));            (* strip parity of char *)
    until (ch = chr(SOH))                        (* if not SOH, get more *)
  end; (* getsoh *)

(*$G+*) (* turn on goto option...need it for next routine *)

function rpack(*var len, num: integer; var data: packettype): char*);

(* read a packet *)

label 1; (* used to emulate C's CONTINUE statement *)

const maxtry = 10000; (* allows for about 1 second of checking *)

var seconds, count, i, ichksum: integer;
    chksum, ptype: char;
    r: char;

  begin
    count := 0;
    seconds := 0;

    if not getsoh(modem) and (state<>'r') then (*if don't get synch char then *)
      begin
        rpack := 'N';                        (* treat as a NAK *)
        num := n mod 64;
        exit(rpack)                          (* and get out of here *)
      end;

  1: count := count + 1;
     if (count>maxtry)and(state<>'r') then (* end of one second *)
        if seconds<timint then begin       (* and aren't waiting for init *)
          count:=0;
          seconds:=seconds+1;
        end
        else begin                       (* if we've tried too many times *)
          rpack := 'N';                      (* treat as NAK *)
          exit(rpack)                        (* and get out of here *)
        end; (* if *)

    if not getch(r,modem) then                (* get a char and *)
            goto 1;                        (* resynch if soh *)

    ichksum := ord(r);                     (* start checksum *)
    len := ord(unchar(r)) - 3;             (* character count *)

    if not getch(r,modem) then             (* get a char and *)
        goto 1;                            (* resynch if soh *)
    ichksum := ichksum + ord(r);
    num := ord(unchar(r));                 (* packet number *)

    if not getch(r,modem) then             (* get a char and *)
        goto 1;                            (* resynch if soh *)
    ichksum := ichksum + ord(r);
    ptype := r;                            (* packet type *)

    for i := 0 to len-1 do                 (* get any data *)
      begin
        if not getch(r,modem) then            (* get a char and *)
            goto 1;                        (* resynch if soh *)
        ichksum := ichksum + ord(r);
        data[i] := r;
      end; (* for i *)
    data[len] := chr(0);                   (* mark end of data *)

    if not getch(r,modem) then                (* get a char and *)
        goto 1;                            (* resynch if soh *)

                                           (* compute final checksum *)
    chksum := chr(aand(ichksum + (aand(ichksum,192) div 64), 63));

    if (chksum <> unchar(r)) then       (* if checksum bad *)
        rpack := chr(0)                      (* return 'false' indicator *)
    else                                   (* else *)
        rpack := ptype;                      (* return packet type *)

    if debug then
      begin
        gotoxy(0,debugline+debnext);
        debnext:= (debnext+1) mod debug_max;
        write('rpack: len:',len,' num:',num,' ptype:',ptype);
      end; (* if *)
  end; (* rpack *)

(*$G-*) (* turn off goto option...don't need it anymore *)