Columbia Kermit/kermit.zip/archives/sperryunivac1100p.zip/univac.pas

Pascal/Delphi Source File | 1984-10-04 | 28KB | 1,179 lines

{$F Here we go.....}

PROCESSOR Kermit (input, output);

CONST
maxtry = 5;
maxbuf = 200 ;
maxlin = 80;
maxwrt = 132;

ascnul = 0;
ascsoh = 1;
asclf  = 10;
asccr  = 13;
ascsp  = 32; { }
ascns  = 35; {#}
ascamp = 38; {&}
ascast = 42; {*}
ascper = 46; {.}
ascb   = 66; {B}
ascd   = 68; {D}
asce   = 69; {E}
ascf   = 70; {F}
ascn   = 78; {N}
ascr   = 82; {R}
ascs   = 83; {S}
asct   = 84; {T}
ascy   = 89; {Y}
ascz   = 90; {Z}
asctil = 126; {~}
ascdel = 127; {rubout}

mark = ascsoh;

TYPE
kermitstates = (kcommand,
                kexit,
                wexit,
                sinitiate,
                sheader,
                sdata,
                sbreak,
                rinitiate,
                rheader,
                rdata);
filestatus = (closed, open, endfile);
ascval = 0..255 ;
ascbuf = RECORD
               ln: INTEGER;
               ch: ARRAY[1..maxbuf] OF ascval;
            END;
line = PACKED ARRAY [1..maxlin] OF CHAR;

{System dependent TYPE}

ident= PACKED ARRAY[1..12] OF CHAR;
sbits = SET of 0..35;

VAR

version: string;
iniflg: boolean; {Set true after first initialization}
server: boolean; {If true, Kermit1100 waits for packets from remote}
state: kermitstates;
filbuf,wrtbuf,redbuf,sndbuf,rcvbuf: ascbuf;
redix:  integer;
rfile,wfile,lfile: text;
fname,rfname,lname: line;
fnlen,rfnlen: INTEGER;
rstatus, wstatus,lstatus: filestatus;
seq,rcvseq: INTEGER;
rlen: INTEGER;
stype,rcvtyp: ascval;
numtry: INTEGER;
numcserr: INTEGER;
ineoln: boolean;
sndonly: boolean;
sndlog, rcvlog, wrtlog, redlog: boolean;
bstrip:  boolean;
creol:  boolean;
lfeol:  boolean;
crlfeol:  boolean;
gotcr:  boolean;

locbsiz:  ascval;
loctout:  ascval;
locnpad:  ascval;
locpad:   ascval;
loceol:   ascval;
locquo:   ascval;
optqu8:   ascval;
locqu8:   ascval;
locrep:   ascval;

rembsiz:  ascval;
remdsiz:  ascval; {Maximum number of data characters to send (remdsiz-3)}
remtout:  ascval;
remnpad:  ascval;
rempad:   ascval;
remeol:   ascval;
remquo:   ascval;
remqu8:   ascval;
remrep:   ascval;

{System dependent VAR}
ruse,wuse,luse: ident;
a0,a1,a2: integer;

{Forward reference procedures }

PROCEDURE error(msg:string);FORWARD;

{System dependent procedures to read and write files}

PROCEDURE readelt1(VAR f:text; filename:ident; name:line; VAR ok:boolean);
   EXTERN;
PROCEDURE openelt1(VAR f:text; filename:ident; name:line; VAR ok:boolean);
   EXTERN;
PROCEDURE closeelt1(VAR f:text; filename:ident; name:line); EXTERN;
PROCEDURE param_string(field:INTEGER; VAR param:STRING); EXTERN;
PROCEDURE csf(image:line; VAR status:sbits);EXTERN;
PROCEDURE write_now(VAR f:text);EXTERN;

{
System dependent procedure to get a file name from the procedure call card.
}
PROCEDURE getspec(field: INTEGER; VAR l: line; VAR len: INTEGER);
VAR s: string[80];
    i: INTEGER;

BEGIN
param_string(field,s);
len:=LENGTH(s);
FOR i:=1 TO len DO l[i]:=s[i];
FOR i:=len+1 TO 80 DO l[i]:=' ';
END;

{$F Character manipulation routines}

{System dependent:  It is assumed that the function ord(c) where
 c is of type char will return the ASCII code for the character c.}

{System dependent:  It is assumed that the function chr(i) where
 i is an integer ASCII code from 0 to 255 will return the appropriate
 character}

FUNCTION makechar (i: INTEGER): ascval;

BEGIN
makechar:=ascsp+i;
END;

FUNCTION unchar (a: ascval): INTEGER;

BEGIN
unchar:=a-ascsp;
END;

FUNCTION tog64(a: ascval): ascval;

BEGIN
tog64:=bxor(64,a); {System dependent}
END;

FUNCTION tog128(a: ascval): ascval;

BEGIN
tog128:=bxor(128,a); {System dependent}
END;

FUNCTION checksum (sum: INTEGER): ascval;

BEGIN
checksum := (((sum MOD 256) DIV 64) +  sum)  MOD 64;
END;
{$F Open and close log file}
PROCEDURE logopn; {System dependent}
VAR i,t: INTEGER;
    lstat: boolean;
    csfsta: sbits;

BEGIN
csf('@asg,az kermitlog. ',csfsta);
IF 35 IN csfsta THEN
   BEGIN
   csf('@asg,t kermitlog.,///256 . ',csfsta);
   END;
IF 35 IN csfsta THEN
   BEGIN
   writeln(lfile,'Error assigning logfile: KERMITLOG');
   END
ELSE
   BEGIN
   lname:='KERMITLOG.mdttt . ';
   er(44{TDATE$},a0);
   a1:=bshr(band(170000000000b,a0),10)+bshr(band(3700000000b,a0),9)
      +band(77777b,bshr(a0,2));
   FOR i:=1 TO 5 DO
      BEGIN
      t:=band(31,bshlc(a1,11+5*i))+48;
      IF t>57 THEN t:=t+7;
      lname[10+i]:=chr(t);
      END;
   luse:='L$F$I$L$E$$$';
   openelt1(lfile,luse,lname,lstat);
   IF lstat=false THEN
      BEGIN
      writeln('Error opening log element:  ',lname);
      END
   ELSE
      BEGIN
      lstatus:=open;
      write(lfile,'Kermit1100 ',version,' Logfile ');
      write_now(lfile); {Write date and time into logfile}
      writeln(lfile);
      writeln(output,'Logging to ',lname);
      END;
   END;
END;

PROCEDURE logcls; {System dependent}

BEGIN
IF lstatus=open THEN
   BEGIN
   closeelt1(lfile,luse,lname);
   END;
END;
{$F Buffer routines}

PROCEDURE bufinit(VAR buf:ascbuf);

BEGIN
buf.ln:=0;
END;

PROCEDURE putbuf(VAR buf: ascbuf; a:ascval);

BEGIN
IF NOT (buf.ln<maxbuf) THEN
   BEGIN
   error('Size of ascii buffer exceeded');
   END
ELSE
   BEGIN
   buf.ln:=buf.ln+1;
   buf.ch[buf.ln]:=a;
   END;
END;

PROCEDURE lintobuf(l: line; len: integer; VAR buf: ascbuf);
VAR i:integer;

BEGIN
bufinit(buf);
FOR i:=1 TO len DO putbuf(buf,ord(l[i]));
END;

PROCEDURE buftolin(buf: ascbuf; VAR l: line; VAR len: integer);
VAR i:integer;
    a:ascval;

BEGIN
len:=buf.ln;
IF len>maxlin THEN len:=maxlin;
FOR i:=1 TO len DO
   BEGIN
   a:=buf.ch[i];
   IF a>127 THEN a:=a-127;
   l[i]:=chr(a);
   END;
FOR i:=len+1 to maxlin DO l[i]:=' ';
END;
{$F Process parameters to and from remote Kermit}
PROCEDURE putpar;
VAR temp: ascval;

BEGIN
bufinit(filbuf);
putbuf(filbuf,makechar(locbsiz));
putbuf(filbuf,makechar(loctout));
putbuf(filbuf,makechar(locnpad));
putbuf(filbuf,tog64(locpad));
putbuf(filbuf,makechar(loceol));
putbuf(filbuf,locquo);
temp:=ascsp;
IF locqu8<>0 THEN temp:=locqu8;
putbuf(filbuf,temp);
putbuf(filbuf,ascsp); {Only know how do to 1 character checksum}
temp:=ascsp;
IF locrep<>0 THEN temp:=locrep;
putbuf(filbuf,temp);
END;

PROCEDURE getpar;

BEGIN
IF rcvbuf.ln > 0 THEN rembsiz:=unchar(rcvbuf.ch[1]);
IF rcvbuf.ln > 1 THEN remtout:=unchar(rcvbuf.ch[2]);
IF rcvbuf.ln > 2 THEN remnpad:=unchar(rcvbuf.ch[3]);
IF rcvbuf.ln > 3 THEN rempad:=tog64(rcvbuf.ch[4]);
IF rcvbuf.ln > 4 THEN remeol:=unchar(rcvbuf.ch[5]);
IF rcvbuf.ln > 5 THEN remquo:=rcvbuf.ch[6];
IF rcvbuf.ln > 6 THEN remqu8:=rcvbuf.ch[7];
IF rcvbuf.ln > 8 THEN remrep:=rcvbuf.ch[9];

remdsiz:=rembsiz-3;
IF state=rinitiate THEN {Our parameters have not been sent}
   BEGIN
   IF locqu8=0 THEN remqu8:=0;
   IF ((32<remqu8) AND (remqu8<63)) OR ((95<remqu8) AND (remqu8<127))
   AND (remqu8<>remquo) THEN
      BEGIN
      locqu8:=ascy; {Remote Kermit specified 8-bit quote character}
      END
   ELSE IF remqu8=ascy THEN
      BEGIN
      locqu8:=ascamp;
      IF (locqu8=remquo) OR (locqu8=remrep) THEN locqu8:=asctil;
      IF (locqu8=remquo) OR (locqu8=remrep) THEN locqu8:=ascns;
      remqu8:=locqu8;
      END
   ELSE
      BEGIN
      locqu8:=0;        {Don't do 8-bit quoting}
      remqu8:=0;
      END;
   IF ((32<remrep) AND (remrep<63)) OR ((95<remrep) AND (remrep<127))
   AND (remrep<>remquo) AND (remrep<>remqu8) AND (locrep<>0) THEN
      BEGIN
      locrep:=remrep; {Agree to do repeat counts}
      END
   ELSE
      BEGIN
      remrep:=0;
      locrep:=0;
      END;
   END
ELSE {Our parameters have already been sent}
   BEGIN
   IF (remqu8<>ascy) AND (remqu8<>locqu8) THEN
      BEGIN
      locqu8:=0; {Don't do 8-bit quoting}
      END;
   IF remrep<>locrep THEN locrep:=0; {Don't do repeat counts}
   END;
END;
{$F Input a packet or a command}
PROCEDURE rcvpkt;
{
This procedure reads all terminal input to Kermit, both packets and
command lines.  On exit, the following global parameters are set:

   rcvtyp = 0 - No SOH encountered, could be command line
            1 - SOH encountered, but packet incomplete
            2 - Checksum error
            Other - ASCII value of packet type from good packet

   rcvseq = -1 - Not a valid packet
            -2 - End of input file encountered
            0...63 - Sequence number from valid packet

   rcvbuf.ln - number of ascii values input since last SOH or
               if no SOH, from beginning of line
   rcvbuf.ch - array of ascii values input
}
VAR c: CHAR;
    av,rt: ascval;
    rst,rsq,cs:INTEGER;

BEGIN
IF rcvlog THEN write(lfile,'rcv <');
IF ineoln THEN
   BEGIN
   readln(input);
   END;
rcvtyp:=0;
IF eof(input) THEN
   BEGIN
   rcvseq:=-2;
   IF rcvlog THEN write(lfile,'@');
   END
ELSE
   BEGIN
   rcvseq:=-1;
   rst:=0;
   ineoln:=eoln(input);
   bufinit(rcvbuf);
   WHILE NOT ineoln DO
      BEGIN
      IF eoln(input) THEN
         BEGIN
         {
         The 1100 EXEC truncates some trailing spaces.  Since a
         valid packet can end in one or more spaces, we will assume
         that short packets should end in spaces and hope that
         the checksum filters out errors.
         }
         av:=ascsp;
         END
      ELSE
         BEGIN
         read(input,c);
         IF rcvlog THEN write(lfile,c);
         av:=ord(c);
         END;
      IF av=mark THEN rst:=1;
      CASE rst OF

         0: {Mark character never encountered.}
            BEGIN
            putbuf(rcvbuf,av);
            ineoln:=eoln(input);
            END;

         1: {Mark character.}
            BEGIN
            rcvtyp:=1;
            rcvseq:=-1;
            bufinit(rcvbuf);
            ineoln:=eoln(input);
            rst:=2;
            END;

         2: {Length of the packet.}
            BEGIN
            cs:=av; {Initialize checksum}
            rlen:=unchar(av)-3;
            rst:=3;
            END;

         3: {Packet number.}
            BEGIN
            cs:=cs+av;
            rsq:=unchar(av);
            rst:=4;
            END;

         4: {Packet type.}
            BEGIN
            cs:=cs+av;
            rt:=av; {remember the packet type}
            rst:=5;
            IF rlen=0 THEN rst:=6;
            END;

         5: {Data portion.}
            BEGIN
            cs:=cs+av;
            putbuf(rcvbuf,av);
            IF rcvbuf.ln = rlen THEN rst:=6;
            END;

         6: {Checksum.}
            BEGIN
            IF checksum(cs)=unchar(av) THEN
               BEGIN
               rcvtyp:=rt;
               rcvseq:=rsq;
               ineoln:=true; {Ignore the rest of the line}
               END
            ELSE
               BEGIN
               numcserr:=numcserr+1;
               rst:=0; {Look for another mark}
               rcvtyp:=2;  {Indicate checksum error}
               ineoln:=eoln(input);
               END;
            END;
         END;
      END;
   END;
IF rcvlog THEN writeln(lfile,'>');
END;
{$F Build and send packets}
PROCEDURE makepacket(ptype: ascval; seq, len: INTEGER);
VAR i: INTEGER;
    c: ascval;
    cs: INTEGER;

BEGIN
bufinit(sndbuf);
FOR i:=1 TO remnpad DO
   BEGIN
   putbuf(sndbuf,rempad);
   END;
putbuf(sndbuf,mark);
c:=makechar(len+3);
cs:=c;                              {Initialize checksum}
putbuf(sndbuf,c);
c:=makechar(seq);
cs:=cs+c;
putbuf(sndbuf,c);
c:=ptype;
cs:=cs+c;
putbuf(sndbuf,c);
FOR i:=1 to len DO
   BEGIN
   c:=filbuf.ch[i];
   cs:=cs+c;
   putbuf(sndbuf,c);
END;
c:=makechar(checksum(cs));
putbuf(sndbuf,c);
{
The 1100 EXEC may strip trailing spaces from the end of output images.
This can cause a problem if the checksum is a space.  To eliminate this
problem, a period will be inserted in the output image after the
checksum whenever the checksum is a space.
}
putbuf(sndbuf,ascper);
{
The 1100 O/S puts a CR LF on the end of each output line.
If the remote EOL character is not CR or LF, then it must
be added to the packet.
}
IF (remeol<>asccr) AND (remeol<>asclf) THEN
   BEGIN
   putbuf(sndbuf,remeol);
   END;
END;

PROCEDURE sndpkt;
VAR
   i:INTEGER;

BEGIN
IF sndlog THEN write(lfile,'snd <');
FOR i:=1 TO sndbuf.ln DO
   BEGIN
   write(output,chr(sndbuf.ch[i]));
   IF sndlog THEN write(lfile,chr(sndbuf.ch[i]));
END;
writeln(output);
IF sndlog THEN writeln(lfile,'>');
END;
{$F File output}

PROCEDURE wrtrec;
VAR
   i:INTEGER;
   c:char;

BEGIN
IF wrtlog THEN write(lfile,'wrt [');
FOR i:=1 TO wrtbuf.ln DO
   BEGIN
   {$A- Turn off range checking, ASCII value may be >127}
   c:=chr(wrtbuf.ch[i]);
   {$A+ Turn on range checking}
   write(wfile,c) ;
   IF wrtlog THEN write(lfile,c);
   END;
writeln(wfile);
IF wrtlog THEN writeln(lfile,']');
bufinit(wrtbuf);
END;

PROCEDURE wrtcls; {System dependent}

BEGIN
IF wstatus=open THEN
   BEGIN
   IF wrtbuf.ln>0 THEN wrtrec;
   closeelt1(wfile,wuse,fname);
   END;
wstatus:=closed;
END;

PROCEDURE wrtopn; {System dependent}
VAR
wstat: boolean;

BEGIN
wrtcls;
wuse:='W$F$I$L$E$$$';
openelt1(wfile,wuse,fname,wstat);
IF wstat THEN wstatus:=open;
bufinit(wrtbuf);
END;

PROCEDURE wrtasc(a:ascval);

BEGIN
IF wrtbuf.ln >=maxwrt THEN wrtrec;
putbuf(wrtbuf,a);
END;
{$F Process data portion of data packet}
PROCEDURE putrec(buf: ascbuf);
VAR
   i,j,repcnt:INTEGER;
   a:ascval;
   qflag: boolean;

BEGIN
i:=1;
WHILE i<= buf.ln DO
   BEGIN
   a:=buf.ch[i]; i:=i+1;
   repcnt:=1;
   IF a=remrep THEN
      BEGIN
      repcnt:=unchar(buf.ch[i]); i:=i+1;
      a:=buf.ch[i]; i:=i+1;
      END;
   qflag:= a=remqu8;
   IF qflag THEN
      BEGIN
      a:=buf.ch[i]; i:=i+1;
      END;
   IF a=remquo THEN
      BEGIN
      a:=buf.ch[i]; i:=i+1;
      IF (a<>remquo) AND (a<>remqu8) AND (a<>remrep) THEN a:=tog64(a);
      END;
   IF qflag THEN a:=tog128(a);
   FOR j:=1 to repcnt DO
      BEGIN
      IF a=asclf THEN
         BEGIN
         IF lfeol OR gotcr THEN
            BEGIN
            wrtrec;
            gotcr:=false;
            END
         ELSE
            BEGIN
            wrtasc(a);
            END;
         END
      ELSE
         BEGIN
         IF gotcr THEN
            BEGIN
            wrtasc(asccr);
            gotcr:=false;
            END;
         IF a=asccr THEN
            BEGIN
            IF creol THEN
               BEGIN
               wrtrec;
               END
            ELSE IF crlfeol THEN
               BEGIN
               gotcr:=true;
               END
            ELSE
               BEGIN
               wrtasc(a);
               END;
            END
         ELSE
            BEGIN
            wrtasc(a);
            END;
         END;
      END;
   END;
END;
{$F File input}
PROCEDURE redrec;
VAR c: CHAR;
    a: ascval;
    nonblank: INTEGER;

BEGIN
bufinit(redbuf);
IF redix >= 0 THEN readln(rfile);
redix:=0;
IF NOT eof(rfile) THEN
   BEGIN
   nonblank:=0;
   IF redlog THEN write(lfile,'red [');
   WHILE NOT eoln(rfile) DO
      BEGIN
      read(rfile,c);
      IF redlog THEN write(lfile,c);
      a:=ord(c);
      putbuf(redbuf,a);
      IF a <> ascsp THEN nonblank := redbuf.ln;
      END;
   IF redlog THEN writeln(lfile,']');
   IF bstrip THEN redbuf.ln := nonblank;
   IF creol OR crlfeol THEN putbuf(redbuf,asccr);
   IF lfeol OR crlfeol THEN putbuf(redbuf,asclf);
   END;
END;

PROCEDURE redopn; {System dependent}
VAR
rstat: boolean;

BEGIN
rstatus:=closed;
ruse:='R$F$I$L$E$$$';
readelt1(rfile,ruse,fname,rstat);
IF rstat THEN rstatus:=open;
redix:=-1;
redbuf.ln:=-1;
END;

PROCEDURE redcls;

BEGIN
rstatus:=closed;
END;

{$F Build data portion of data packet}
PROCEDURE getrec;
VAR a: ascval;
    exit: BOOLEAN;
    prevln,previx,tix: INTEGER;

BEGIN
bufinit(filbuf);
IF eof(rfile) THEN
   BEGIN
   rstatus:=endfile;
   END
ELSE
   BEGIN
   exit:=false;
   REPEAT
      IF redix >= redbuf.ln THEN
         BEGIN
         redrec; {get another record and strip spaces}
         IF eof(rfile) THEN
            BEGIN
            exit:=true;
            IF filbuf.ln=0 THEN rstatus:=endfile;
            END;
         END;
      IF redix < redbuf.ln THEN
         BEGIN
         prevln:=filbuf.ln;
         previx:=redix;
         redix:=redix+1;
         a:=redbuf.ch[redix];
         IF locrep<>0 THEN
            BEGIN
            tix:=redix+1;
            WHILE (a=redbuf.ch[tix]) AND (tix<=redbuf.ln) DO tix:=tix+1;
            tix:=tix-redix;   {tix is now the repeat count}
            IF tix>3 THEN
               BEGIN
               IF tix>94 THEN tix:=94;
               putbuf(filbuf,locrep);
               putbuf(filbuf,makechar(tix));
               redix:=redix-1+tix;
               END;
            END;
         IF (a>127) THEN
            BEGIN
            IF locqu8<>0 THEN putbuf(filbuf,locqu8);
            a:=tog128(a);
            END;
         IF (a<32) OR (a=ascdel) THEN
            BEGIN
            putbuf(filbuf,locquo);
            a:=tog64(a);
            END;
         IF (a=locquo) OR (a=locqu8) OR (a=locrep) THEN
            BEGIN
            putbuf(filbuf,locquo);
            END;
         putbuf(filbuf,a);
         IF filbuf.ln >= remdsiz THEN
            BEGIN
            exit:=true;
            IF filbuf.ln>remdsiz then
               BEGIN
               {Character expansion caused buffer length to be
                exceeded.  Back up.}
               filbuf.ln:=prevln;
               redix:=previx;
               END;
            END;
         END;
   UNTIL exit;
   END;
END;

{$F Send states}
PROCEDURE sendinitiate;

BEGIN
IF fnlen>0 THEN
   BEGIN
   redopn;
   IF rstatus=open THEN
      BEGIN
      putpar; {Put parameters into buffer}
      makepacket(ascs,seq,filbuf.ln); {Make packet with our parameters}
      numtry:=0;
      state:=sheader;
      END
   ELSE
      BEGIN
      error('Error opening read file');
      state:=kexit;
      END;
   END
ELSE
   BEGIN
   error('No read file specified');
   state:=kexit;
   END;
END;

PROCEDURE sendheader;

BEGIN
IF rcvtyp=ascy THEN
   BEGIN
   IF not sndonly THEN getpar; {Get parameters from ACK of 'S' packet}
   IF rfnlen>0 THEN
      BEGIN
      lintobuf(rfname,rfnlen,filbuf); {Send remote file name.}
      END
   ELSE
      BEGIN
      lintobuf(fname,fnlen,filbuf);   {Send local file name.}
      END;
   numtry:=0;
   seq:=(seq+1) mod 64;
   makepacket(ascf,seq,filbuf.ln);
   state:=sdata
   END;
END;

PROCEDURE senddata;

BEGIN
IF rcvtyp=ascy THEN
   BEGIN
   getrec;
   numtry:=0;
   seq:=(seq+1) mod 64;
   IF rstatus = open THEN
      BEGIN
      makepacket(ascd,seq,filbuf.ln);
      END
   ELSE
      BEGIN
      makepacket(ascz,seq,0);
      state:=sbreak;
      fnlen:=0;
      END;
   END;
END;

PROCEDURE sendbreak;

BEGIN
IF rcvtyp=ascy THEN
   BEGIN
   numtry:=0;
   seq:=(seq+1) mod 64;
   makepacket(ascb,seq,0);
   END;
state:=wexit;
END;
{$F Receive states}
PROCEDURE receiveinitiate;

BEGIN
IF rcvtyp=ascs  THEN
   BEGIN
   getpar; {Get parameters from packet}
   putpar; {Put parameters into buffer}
   makepacket(ascy,seq,filbuf.ln); {Make ACK packet with our parameters}
   seq:=rcvseq;
   numtry:=0;
   seq:=(seq+1) mod 64;
   state:=rheader;
   END
ELSE
   BEGIN
   error('Wrong packet in receive initiation');
   state:=kexit;
   END;
END;

PROCEDURE receiveheader;

BEGIN
IF rcvtyp=ascf THEN
   BEGIN
   IF fnlen=0 THEN
      BEGIN
      buftolin(rcvbuf,fname,fnlen);
      END;
   IF fnlen>0 THEN
      BEGIN
      wrtopn;
      IF wstatus=open THEN
         BEGIN
         makepacket(ascy,seq,0);
         numtry:=0;
         seq:=(seq+1) mod 64;
         state:=rdata;
         END
      ELSE
         BEGIN
         error('Error opening write file');
         state:=kexit;
         END;
      END
   ELSE
      BEGIN
      error('No output file specified');
      state:=kexit;
      END;
   END
ELSE IF rcvtyp=ascb THEN
   BEGIN
   makepacket(ascy,seq,0);
   sndpkt;
   state:=kexit;
   END
ELSE
   BEGIN
   error('Wrong packet receiveing file header');
   state:=kexit;
   END;
END;

PROCEDURE receivedata;

BEGIN
IF rcvtyp=ascd THEN
   BEGIN
   putrec(rcvbuf);
   makepacket(ascy,seq,0);
   numtry:=0;
   seq:=(seq+1) mod 64;
   END
ELSE IF rcvtyp=ascz THEN
   BEGIN
   wrtcls;
   fnlen:=0;
   makepacket(ascy,seq,0);
   numtry:=0;
   seq:=(seq+1) mod 64;
   state:=rheader;
   END
ELSE
   BEGIN
   error('Unexpected packet receiving data');
   state:=kexit;
   END;
END;
{$F Error processing}

{Process fatal errors}

PROCEDURE error; {parameters appear above in forward reference}
VAR i,l:integer;

BEGIN
l:=length(msg);
IF l>maxbuf-6 THEN l:=maxbuf-6;
bufinit(filbuf);
FOR i:=1 to 3 DO putbuf(filbuf,ascsp); {Make message readable in packet}
FOR i:=1 to l DO putbuf(filbuf,ord(msg[i]));
FOR i:=1 to 3 DO putbuf(filbuf,ascsp); {Make message readable in packet}
makepacket(asce,seq,filbuf.ln);
sndpkt;
state:=kexit;
END;
{$F Command state}
PROCEDURE kermitcommand;

BEGIN
REPEAT
   rcvpkt;
   IF rcvseq>-1 THEN
      BEGIN
      IF rcvtyp=ascs THEN
         BEGIN
         state:=rinitiate;
         END
      ELSE IF rcvtyp=ascr THEN
         BEGIN
         IF fnlen=0 THEN
            BEGIN
            buftolin(rcvbuf,fname,fnlen);
            END;
         state:=sinitiate;
         END
      ELSE
         BEGIN
         error('Unexpected packet type');
         END;
      END
   ELSE IF rcvseq=-1 THEN
      BEGIN
      writeln('No commands implemented');
      END
   ELSE IF rcvseq=-2 THEN
      BEGIN
      state:=kexit;
      server:=false;
      END;
UNTIL state<>kcommand;
END;
{$F Get processor call options and file specifications}

PROCEDURE getoptions; {System dependent}

BEGIN
getspec(1,fname,fnlen);   {Get local file name, if any.}
getspec(2,rfname,rfnlen); {Get remote file name, if any.}
IF 'S' IN options THEN state:=sinitiate;
IF 'R' IN options THEN state:=rinitiate;
IF 'T' IN options THEN
   BEGIN
   sndonly:=true;
   state:=sinitiate;
   server:=false;
   END;
IF 'B' IN options THEN
   BEGIN
   locbsiz:=94;
   END;
IF 'C' IN options THEN
   BEGIN
   crlfeol:=false;
   creol:=true;
   lfeol:=false;
   END;
IF 'L' IN options THEN
   BEGIN
   sndlog:=true;
   rcvlog:=true;
   wrtlog:=true;
   redlog:=true;
   END;
optqu8:=0; {Assume no eight-bit quoting will be done}
IF 'Q' IN options THEN
   BEGIN
   optqu8:=ascamp; {Eight-bit quoting may be done}
   END;
IF ('W' IN options) AND ('S' IN options) THEN
   BEGIN
   a1:=30000;
   er(48{TWAIT$},a0,a1);
   END;
END;
{$F Initialization state}
PROCEDURE kermitinitialize;
VAR lstat: boolean;

BEGIN
state:=kcommand;
numtry:=0;
seq:=0;
fnlen:=0; {Indicate no file name yet}
bstrip:=true;

locbsiz:=78;
loctout:=12;
locnpad:=0;
locpad:=0;
loceol:=asccr;
locquo:=ascns;
{  locqu8 will be set after options are processed. }
locrep:=asctil; {Initialize to 0 to turn off repeat counts}

rembsiz:=78;
remdsiz:=rembsiz-3;
remtout:=12;
remnpad:=0;
rempad:=0;
remeol:=asccr;
remqu8:=0;
remrep:=0;

bufinit(sndbuf);

{The following should only be done on the first call to initialize}
IF iniflg=false THEN
   BEGIN
   sndonly:=false;
   sndlog:=false;
   rcvlog:=false;
   wrtlog:=false;
   redlog:=false;
   crlfeol:=true;
   creol:=false;
   lfeol:=false;
   rstatus:=closed;
   wstatus:=closed;
   lstatus:=closed;

   {System dependent initialization}
   ineoln:=false;  {Indicate no readln necessary for first line}
   getoptions;     {Process options and file specifications}
   IF sndlog OR rcvlog OR wrtlog OR redlog THEN logopn
   END;
locqu8:=optqu8; {Eight-bit quoting done only with Q-option}
iniflg:=true;
END;
{$F Main block}


BEGIN
version:= '2.0';
writeln(output,'Kermit 1100 ',version);
iniflg:=false;
server:=true;
WHILE server DO
   BEGIN
   kermitinitialize;
   IF state=kcommand THEN kermitcommand;
   IF state=sinitiate THEN sendinitiate;
   IF state=rinitiate THEN receiveinitiate;
   WHILE state<>kexit DO
      BEGIN
      REPEAT
         sndpkt;
         numtry:=numtry+1;
         IF sndonly THEN
            BEGIN
            rcvseq:=seq;
            rcvtyp:=ascy;
            rcvbuf.ln:=0;
            END
         ELSE
            BEGIN
            rcvpkt;
            END;
         IF rcvtyp=ascn THEN
            BEGIN
            {We have just received a NAK.  The Kermit protocol would
            be much simpler and no less effective if the NAK had never
            been included.  However, since this is not universally
            appreciated, one has to deal with them.  To do so, we
            will convert a NAK into an ACK with the previous sequence
            number.}
            rcvseq:=(rcvseq-1) mod 64;
            rcvtyp:=ascy;
            END
         ELSE IF rcvseq=-2 THEN {End of file on input}
            BEGIN
            error('End of file on input data');
            state:=kexit;
            server:=false;
            END;
      UNTIL (rcvseq=seq) OR (numtry>=maxtry) OR (state=kexit);
      IF (rcvseq<>seq) AND (state<>kexit) THEN
         BEGIN
         error('Failed to receive expected packet');
         state:=kexit;
         END
      ELSE IF rcvtyp=asce THEN {Just received error packet}
         BEGIN
         state:=kexit
         END
      ELSE
         BEGIN
         CASE state OF
            sheader     :sendheader;
            sdata       :senddata;
            sbreak      :sendbreak;
            rheader     :receiveheader;
            rdata       :receivedata;
            wexit       :state:=kexit; {Go around one more time, then exit}
            kexit       :;
            END;
         END
   END;
   wrtcls;
   END;
logcls;
writeln('Kermit End');
END .