kermit.columbia.edu/kermit.columbia.edu.tar/kermit.columbia.edu/rt11pascal/rtsend.pas

Pascal/Delphi Source File | 1984-05-21 | 7KB | 368 lines

{ This is the SendSwitch Overlay }

{ Clear Buffer for input Line }
PROCEDURE CLRBUF;
EXTERNAL;


  PROCEDURE GetData({ Returning }   VAR newstate:KermitStates);
    { get data from file into ThisPacket }
  VAR
    { and return next state - data &  EOF }
    x,c : character;
    i: integer;
   BEGIN
     IF (NumTry=1)
      THEN
       BEGIN
     i := 1;
     x := BLANK;
     WITH ThisPacket^ DO
      BEGIN
        WHILE (i< SizeSend - 8 ) AND (x <> ENDFILE)
        { leave room for quote  & NEWLINE }
        DO
         BEGIN
           x := getcf(c,DiskFile);
           IF (x<>ENDFILE)
        THEN
        BEGIN
        { Process Binary data }
        IF (x < NULLCHAR) THEN
           CASE BinaryMode OF
            NotSupported: BEGIN
                PutCn('Binary char (dec) = ',x,STDERR);
                ErrorPack('No Binary Support   ');
                      END;
            FullBinary: { nothing to do };
            Quoted : BEGIN
                    data[i] := QuoteForBinary;
                    i := i + 1;
                    x := x + 128; { convert to ASCII }
                 END;
           END; { case }

        IF (IsControl(x)) OR (x=SendQuote) OR (x=QuoteForBinary)
         THEN
          BEGIN           { control char -- quote }
            IF x=NEWLINE
             THEN      { use proper EOL }
             CASE EOLforFile OF
               LineFeed:   { ok as is };
               CrLf:
            BEGIN
              data[i] := SendQuote;
              i := i+1;
              data[i] := Ctl(CR);
              i := i+1;
                          { LF will sent
               below }
            END;
               JustCR:     x := CR;
              END { case };
            data[i] := SendQuote;
            i := i+1;
            IF (x<>SendQuote) AND (x<>QuoteForBinary)
             THEN
             data[i] := Ctl(x)
             ELSE
             data[i] := x;
          END
         ELSE               { regular char }
         data[i] := x;
           END;

           IF (x<>ENDFILE)
        THEN
         BEGIN
           i := i+1;    { increase count for next char }
           AddTo(ChInFileSend,1);
         END;
         END;

        data[i] := ENDSTR;   { to terminate string }

        count := i -1;       { length }
        seq := n;
        ptype := TYPED;

        IF (x=ENDFILE)
         THEN
          BEGIN
        newstate := EOFile;
        Sclose(DiskFile);
        DiskFile := IOERROR;
          END
         ELSE
         newstate := FileData;
        SaveState := newstate;        { save state }
      END
       END
      ELSE
      newstate := SaveState;        { get old state }
   END;

  FUNCTION GetNextFile: { Returning } boolean;
    { get next file to send in ThisPacket }
    { returns true if no more }
  VAR
    result: boolean;
    tempstr : string;
    i : integer;
   BEGIN
     result := true;
     IF (NumTry=1)
      THEN
      WITH ThisPacket^ DO
       BEGIN
      REPEAT
       IF getarg(NextArg,data,MAXSTR)
        THEN
         BEGIN            { open file  }
           IF Exists(data)
        THEN
         BEGIN
           DiskFile := Sopen(data,-IOREAD);
           { Check for : for device -- skip it }
           i := index(data,COLON);
           IF (i > 0) THEN
            BEGIN
              i := i + 1;
              scopy(data,i,tempstr,1);
              scopy(tempstr,1,data,1);
            END;
           count := length(data);
           AddTo(ChInFileSend , count);
           seq := n;
           ptype := TYPEF;
           IF DiskFile <= IOERROR
            THEN
            ErrorPack('Cannot open file    ');
           result := false;
         END;
         END;
       NextArg := NextArg+1;
      UNTIL ( NextArg > nargs ) OR ( NOT result )
       END
      ELSE
      result := false; { for saved packet }
     GetNextFile := result;
   END;

  PROCEDURE SendFile; { send file name packet }
   BEGIN
     Verbose( 'Sending ....        ');
     IF NumTry > MaxTry
      THEN
       BEGIN
     PutErr ('Send file - Too Many');
     State := Abort;      { too many tries, abort }
       END
      ELSE
       BEGIN
     NumTry := NumTry+1;
     IF GetNextFile
      THEN
       BEGIN
         State := Break;
         NumTry := 0;
       END
      ELSE
       BEGIN
         IF Verbosity
          THEN
           BEGIN
         IF (NumTry = 1)
          THEN putstr(ThisPacket^.data,STDERR)
          ELSE putstr(LastPacket^.data,STDERR);
         putcf(NEWLINE,STDERR);
           END;

         SendPacket;     { send this packet }
         IF RecvACK
          THEN
           BEGIN
         State := FileData;
         NumTry := 0;
         n := (n+1) MOD 64;
           END
       END;
       END;
   END;


  PROCEDURE SendData;  { send file data packets }
  VAR
    newstate: KermitStates;
   BEGIN
     IF Verbosity
      THEN
      PutCN ( 'Sending data        ',n,STDERR);
     IF NumTry > MaxTry
      THEN
       BEGIN
     State := Abort;       { too many tries, abort }
     PutErr ('Send data - Too many');
       END
      ELSE
       BEGIN
     NumTry := NumTry+1;
     GetData(newstate);
     SendPacket;
     IF RecvACK
      THEN
       BEGIN
         State := newstate;
         NumTry := 0;
         n := (n+1) MOD 64;
       END
       END;
   END;


  PROCEDURE SendEOF;    { send EOF  packet }
   BEGIN
     Verbose ('Sending EOF         ');
     IF NumTry > MaxTry
      THEN
       BEGIN
     State := Abort;       { too many tries, abort }
     PutErr('Send EOF - Too Many ');
       END
      ELSE
       BEGIN
     NumTry := NumTry+1;
     IF (NumTry = 1)
      THEN
       BEGIN
         WITH ThisPacket^ DO
          BEGIN
        ptype := TYPEZ;
        seq := n;
        count := 0;
          END;
         Sclose(DiskFile);
       END;
     SendPacket;
     IF RecvACK
      THEN
       BEGIN
         State := FileHeader;
         NumTry := 0;
         n := (n+1) MOD 64;
       END
       END;
   END;


  PROCEDURE SendBreak; { send break packet }
   BEGIN
     Verbose ('Sending break       ');
     IF NumTry > MaxTry
      THEN
       BEGIN
     State := Abort;       { too many tries, abort }
     PutErr('Send break -Too Many');
       END
      ELSE
       BEGIN
     NumTry := NumTry+1;
     { make up packet  }
     IF NumTry = 1
      THEN
       BEGIN
         WITH ThisPacket^ DO
          BEGIN
        ptype := TYPEB;
        seq := n;
        count := 0;
          END
       END;
     SendPacket; { send this packet }
     IF RecvACK
      THEN
       BEGIN
         State := Complete;
       END
       END;
   END;


  PROCEDURE SendInit;  { send init packet }
   BEGIN
     Verbose ('Sending init        ');
     IF NumTry > MaxTry
      THEN
       BEGIN
     State := Abort;      { too many tries, abort }
     PutErr('Cannot Initialize   ');
       END
      ELSE
       BEGIN
     NumTry := NumTry+1;
     IF (NumTry = 1)
      THEN
       BEGIN
         WITH ThisPacket^ DO
          BEGIN
        EnCodeParm(data);
        count := NUMPARAM;
        seq := n;
        ptype := TYPES;
          END
       END;

     SendPacket; { send this packet     }
     CLRBUF;     { Clear input buffer ! }
     IF RecvACK
      THEN
       BEGIN
         WITH CurrentPacket^ DO
          BEGIN
        IF OneWayOnly
         THEN  { use same data if test mode }
         data := LastPacket^.data;
         DeCodeParm(data);
          END;

         State := FileHeader;
         NumTry := 0;
         MaxTry := DEFTRY;  { use regular default now  }
         n := (n+1) MOD 64;
       END;
       END;
   END;

  {$E+}

  PROCEDURE SendSwitch;
    { Send-switch is the state table switcher for sending files.
      It loops until either it is finished or a fault is encountered.
      Routines called by sendswitch are responsible for changing the state.
     }

   BEGIN
     StartRun;
     IF (NOT OneWayOnly )
      THEN
        Sleep(Delay);
     n := 0;
      REPEAT
       CASE State OF
     FileData:     SendData;         { data-send state }
     FileHeader:   SendFile;         { send file name }
     EOFile:       SendEOF;          { send end-of-file }
     Init:         SendInit;         { send initialize }
     Break:        SendBreak;        { send break }
     Complete:     { nothing };
     Abort:        { nothing };
    END { case };
      UNTIL ( (State = Abort) OR (State=Complete) );
   END;