home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / ucsdmagiscan2 / sendsw.text < prev    next >
Text File  |  2011-08-11  |  12KB  |  440 lines

  1.  
  2. (* Send Section *)
  3. UCSD Pascal KERMIT for the Terak p-System, from Kate MacGregor, Cornell U
  4.  adapted by H Balen for the Magiscan 2, Lancaster U 
  5.  
  6. segment procedure sendsw(var send_ok: boolean);
  7.  
  8. var io_status: integer;
  9.  
  10. procedure openfile;
  11.  
  12. (* resets file & gets past first 2 blocks *)
  13. var
  14.   OK   : boolean;
  15.  
  16.   begin
  17.   OK := ReadOpenF(filename,TranState);
  18.   io_status := io_result;
  19.   end; (* openfile *)
  20.  
  21. function sinit: char;
  22.  
  23. (* send init packet & receive other side's *)
  24.  
  25. var num, len, i: integer;  (* packet number and length *)
  26.     ch: char;
  27.  
  28.   begin
  29.     if debug then
  30.         debugwrite('sinit');
  31.  
  32.     if numtry > maxtry then
  33.       begin
  34.         sinit := 'a';
  35.         exit(sinit)
  36.       end;
  37.  
  38.     num_try := num_try + 1;
  39.     spar(packet);
  40.  
  41.     if istbrr then ch:=rcvbbt; (* clear modem buffer *)
  42.  
  43.     refresh_screen(numtry,n);
  44.  
  45.     spack('S',n mod 64,7,packet);
  46.  
  47.     ch := rpack(len,num,recpkt);
  48.  
  49.     if (ch = 'N') then
  50.       begin
  51.         sinit := 's';
  52.         exit(sinit)
  53.       end (* if 'N' *)
  54.     else if (ch = 'Y') then
  55.       begin
  56.         if ((n mod 64) <> num) then       (* not the right ack *)
  57.           begin
  58.             sinit := state;
  59.             exit(sinit)
  60.           end;
  61.         rpar(recpkt);
  62.         if (eol = chr(0)) then   (* if they didn't spec eol *)
  63.             eol := chr(my_eol);    (* use mine *)
  64.         if (quote = chr(0)) then (* if they didn't spec quote *)
  65.             quote := my_quote;     (* use mine *)
  66.         ctl_set := [chr(1)..chr(31),chr(del),quote];
  67.         if TranState <> TxtFile then
  68.           begin
  69.           if (bquote = 'Y') then
  70.             bquote := my_bquote;
  71.           ctl_set := [chr(1)..chr(31),chr(del),quote,bquote];
  72.           end;
  73.         numtry := 0;
  74.         n := n + 1;              (* increase packet number *)
  75.         sinit := 'f';
  76.         exit(sinit)
  77.       end (* else if 'Y' *)
  78.     else if (ch = 'E') then
  79.       begin
  80.         error(recpkt,len);
  81.         sinit := 'a'
  82.       end (* if 'E' *)
  83.     else if (ch = chr(0)) then
  84.         sinit := state
  85.     else if (ch <> 'N') then
  86.         sinit := 'a'
  87.   end; (* sinit *)
  88.  
  89. function sdata: char;
  90.  
  91. (* send file data *)
  92.  
  93. var num, len: integer;
  94.     ch: char;
  95.     packarray: array[false..true] of packettype;
  96.     sizearray: array[false..true] of integer;
  97.     current: boolean;
  98.     b: boolean;
  99.  
  100. function other(b: boolean): boolean;
  101.  
  102. (* complements a boolean which is used as array index *)
  103.  
  104.   begin
  105.     if b then
  106.         other := false
  107.     else
  108.         other := true
  109.   end; (* other *)
  110.  
  111.   begin
  112.     current := true;
  113.     packarray[current] := packet;
  114.     sizearray[current] := size;
  115.     while (state = 'd') do
  116.       begin
  117.         if (numtry > maxtry) then             (* if too many tries, give up *)
  118.             state := 'a';
  119.  
  120.         b := other(current);
  121.         numtry := numtry + 1;
  122.  
  123.         refresh_screen(numtry,n);
  124.                                           (* send a data packet *)
  125.         spack('D',n mod 64,sizearray[current],packarray[current]);
  126.  
  127.         ch := rpack(len,num,recpkt);      (* receive a packet *)
  128.                                           (* set up next packet *)
  129.         if TranState = TxtFile then
  130.           sizearray[b] := bufill(packarray[b])
  131.          else
  132.            sizearray[b] := Bbufill(packarray[b]);
  133.  
  134.         if ch = 'N' then                  (* NAK, so just stay in this state *)
  135.             if ((n+1) mod 64 <> num) then (* unless NAK for next, which *)
  136.                 sdata := state
  137.             else                          (* is just like ACK for this packet *)
  138.               begin
  139.                 if num > 0 then
  140.                     num := (num - 1)      (* in which case, decrement num *)
  141.                 else
  142.                     num := 63;
  143.                 ch := 'Y';                (* and indicate an ACK *)
  144.               end; (* else *)
  145.  
  146.         if (ch = 'Y') then
  147.            begin
  148.              if ((n mod 64) <> num) then (* if wrong ACK *)
  149.                begin
  150.                  sdata := state;         (* stay in same state *)
  151.                  exit(sdata);            (* get out of here *)
  152.                end; (* if *)
  153.              if numtry > 1 then          (* if anything in buffer, flush it *)
  154.                  if istbrr then begin
  155.                    ch:=rcvbbt;
  156.                    ch:='Y';
  157.                    end;
  158.              numtry := 0;
  159.              n := n + 1;
  160.              current := b;
  161.              if sizearray[current] = ateof then
  162.                  state := 'z'            (* set state to eof *)
  163.              else
  164.                  state := 'd'            (* else stay in data state *)
  165.            end (* if *)
  166.           else if (ch = 'E') then
  167.             begin
  168.               error(recpkt,len);
  169.               state := 'a'
  170.             end (* if 'E' *)
  171.           else if (ch = chr(0)) then      (* receive failure, so stay in d *)
  172.             begin
  173.             end
  174.           else if (ch <> 'N') then
  175.            eger;
  176.  
  177.   begin
  178.     for i := 1 to length(s) do
  179.         if s[i] in ['a'..'z'] then
  180.             s[i] := chr(ord('A') + ord(s[i]) - ord('a'))
  181.   end; (* uppercase *)
  182.  
  183.   begin
  184.     count := 0;
  185.     l := length(fn);
  186.     for i := 1 to l do                                  (* count '.'s in fn *)
  187.         if fn[i] = '.' then
  188.             count := count + 1;
  189.     for i := 1 to count-1 do                            (* remove all but 1 *)
  190.       begin
  191.         j := 1;
  192.         while (j < l) and (fn[j] <> '.') do
  193.             j := j + 1;
  194.             delete(fn,j,1);l := l - 1
  195.       end; (* for i *)
  196.     l := length(fn);
  197.     i := pos(':',fn);
  198.     if (i <> 0) then
  199.       begin
  200.         fn := copy(fn,i,l-i);
  201.         l := length(fn)
  202.       end;
  203.     i := 1;
  204.     while (i <= length(fn)) do
  205.         if not(fn[i] in ['a'..'z','A'..'Z','.','0'..'9']) then
  206.             delete(fn,i,1)
  207.         else
  208.             i := i + 1;
  209.     uppercase(fn)
  210.   end; (* legalize *)
  211.  
  212.   begin
  213.     if debug then
  214.         debugwrite('sfile');
  215.  
  216.     if (numtry > maxtry) then          (* if too many tries, give up *)
  217.       begin
  218.         sfile := 'a';
  219.         exit(sfile)
  220.       end;
  221.     numtry := numtry + 1;
  222.  
  223.     oldfn := filename;
  224.     legalize(filename);                (* make filename acceptable to remote *)
  225.     len := length(filename);
  226.  
  227.     moveleft(filename[1],fn[0],len);   (* move filename into a packettype *)
  228.  
  229.     gotoxy(filepos,fileline);
  230.     write(oldfn,' ==> ',filename);
  231.  
  232.     refresh_screen(numtry,n);
  233.  
  234.     spack('F',n mod 64,len,fn);               (* send file header packet *)
  235.  
  236.     ch := rpack(len,num,recpkt);
  237.  
  238.     if ch = 'N' then                   (* NAK, so just stay in this state *)
  239.         if ((n+1) mod 64 <> num) then  (* unless NAK for next packet, which *)
  240.             begin
  241.             sfile := 'f';
  242.             exit(sfile)                (* is just like ACK for this packet *)
  243.             end
  244.         else
  245.           begin
  246.             if (num > 0) then
  247.                 num := (num - 1)       (* in which case, decrement num *)
  248.             else
  249.                 num := 63;
  250.             ch := 'Y';                 (* and indicate an ACK *)
  251.           end; (* else *)
  252.  
  253.     if (ch = 'Y') then
  254.       begin
  255.         if ((n mod 64) <> num) then  (* if wrong ACK, stay in F state *)
  256.             begin
  257.             sfile := 'f';
  258.             exit(sfile)
  259.             end;
  260.         if TranState = TxtFile then
  261.           size := bufill(packet)     (* get first data from file *)
  262.          else
  263.            size := Bbufill(packet);
  264.         numtry := 0;
  265.         n := n + 1;
  266.         sfile := 'd';
  267.       end (* if *)
  268.     else if (ch = 'E') then
  269.       begin
  270.         error(recpkt,len);
  271.         sfile := 'a'
  272.       end (* if 'E' *)
  273.     else if (ch <> chr(0)) and (ch <> 'N') then (* don't recognize it *)
  274.         sfile := 'a'
  275.   end; (* sfile *)
  276.  
  277. function seof: char;
  278.  
  279. (* send end of file *)
  280.  
  281. var num, len: integer;
  282.     ch: char;
  283.  
  284.   begin
  285.     if debug then
  286.         debugwrite('seof');
  287.  
  288.     if (numtry > maxtry) then          (* if too many tries, give up *)
  289.       begin
  290.         seof := 'a';
  291.         exit(seof)
  292.       end;
  293.     numtry := numtry + 1;
  294.  
  295.     refresh_screen(numtry,n);
  296.  
  297.     spack('Z',(n mod 64),0,packet);    (* send end of file packet *)
  298.  
  299.     if debug then
  300.         debugwrite('seof1');
  301.  
  302.     ch := rpack(len,num,recpkt);
  303.     if ch = 'N' then                   (* NAK, so just stay in this state *)
  304.         if ((n+1) mod 64 <> num) then  (* unless NAK for next packet, which *)
  305.             exit(seof)                 (* is just like ACK for this packet *)
  306.         else
  307.           begin
  308.             if num > 0 then
  309.                 num := (num - 1)       (* in which case, decrement num *)
  310.             else
  311.                 num := 63;
  312.             ch := 'Y';                 (* and indicate an ACK *)
  313.           end; (* else *)
  314.  
  315.     if (ch = 'Y') then
  316.       begin
  317.         if debug then
  318.             debugwrite('seof2');
  319.         if ((n mod 64) <> num) then     (* if wrong ACK, stay in F state *)
  320.             exit(seof);
  321.         numtry := 0;
  322.         n := n + 1;
  323.         if debug then
  324.             debugwrite(concat('closing ',s));
  325.         CloseF(filename,False);
  326.         seof := 'b'
  327.       end (* if *)
  328.     else if (ch = 'E') then
  329.       begin
  330.         error(recpkt,len);
  331.         seof := 'a'
  332.       end (* if 'E' *)
  333.     else if (ch = chr(0)) then         (* receive failed, so stay in z state *)
  334.       begin
  335.       end
  336.     else if (ch <> 'N') then           (* other error, just abort *)
  337.         seof := 'a'
  338.   end; (* seof *)
  339.  
  340. function sbreak: char;
  341.  
  342. var num, len: integer;
  343.     ch: char;
  344.  
  345. (* send break (end of transmission) *)
  346.  
  347.   begin
  348.     if debug then
  349.         debugwrite('sbreak');
  350.  
  351.     if (numtry > maxtry) then          (* if too many tries, give up *)
  352.       begin
  353.         sbreak := 'a';
  354.         exit(sbreak)
  355.       end;
  356.     numtry := numtry + 1;
  357.  
  358.     refresh_screen(numtry,n);
  359.  
  360.     spack('B',(n mod 64),0,packet);    (* send end of file packet *)
  361.  
  362.     ch := rpack(len,num,recpkt);
  363.     if ch = 'N' then                   (* NAK, so just stay in this state *)
  364.         if ((n+1) mod 64 <> num) then  (* unless NAK for next packet, which *)
  365.             exit(sbreak)               (* is just like ACK for this packet *)
  366.         else
  367.           begin
  368.             if num > 0 then
  369.                 num := (num - 1)       (* in which case, decrement num *)
  370.             else
  371.                 num := 63;
  372.             ch := 'Y';                 (* and indicate an ACK *)
  373.           end; (* else *)
  374.  
  375.     if (ch = 'Y') then
  376.       begin
  377.         if ((n mod 64) <> num) then    (* if wrong ACK, stay in B state *)
  378.             exit(sbreak);
  379.         numtry := 0;
  380.         n := n + 1;
  381.         sbreak := 'c'                  (* else, switch state to complete *)
  382.       end (* if *)
  383.     else if (ch = 'E') then
  384.       begin
  385.         error(recpkt,len);
  386.         sbreak := 'a'
  387.       end (* if 'E' *)
  388.     else if (ch = chr(0)) then         (* receive failed, so stay in z state *)
  389.       begin
  390.       end
  391.     else if (ch <> 'N') then           (* other error, just abort *)
  392.         sbreak := 'a'
  393.   end; (* sbreak *)
  394.  
  395. (* state table switcher for sending *)
  396.  
  397.   begin (* sendsw *)
  398.  
  399.     if debug then
  400.         debugwrite(concat('Opening ',filename));
  401.  
  402.     openfile;
  403.     if io_status <> 0 then
  404.       begin
  405.         writeln(chr(ff){clear_screen});
  406.         ino_error(io_status);
  407.         send_ok := false;
  408.         exit(sendsw)
  409.       end;
  410.  
  411.     write_screen('Sending');
  412.     state := 's';
  413.     n := 0;       (* set packet # *)
  414.     numtry := 0;
  415.     while true do
  416.         if state in ['d', 'f', 'z', 's', 'b', 'c', 'a'] then
  417.           case state of
  418.               'd': state := sdata;
  419.               'f': state := sfile;
  420.               'z': state := seof;
  421.               's': state := sinit;
  422.               'b': state := sbreak;
  423.               'c': begin
  424.                      send_ok := true;
  425.                      exit(sendsw)
  426.                    end; (* case c *)
  427.               'a': begin
  428.                      send_ok := false;
  429.                      exit(sendsw)
  430.                    end (* case a *)
  431.             end (* case *)
  432.         else (* state not in legal states *)
  433.           begin
  434.             send_ok := false;
  435.             CloseF(filename,send_ok);
  436.             exit(sendsw)
  437.           end (* else *)
  438.   end; (* sendsw *)
  439.  
  440.