home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pub / rt11pascal / rtproc.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  26KB  |  1,293 lines

  1. { Software Tools in PASCAL -- Procedures used by KERMIT }
  2. { Also Externals called by Send & Receive Switch }
  3.  
  4. {$E+}
  5.  
  6.  PROCEDURE stiphalt; { used by external procedures for halt }
  7.  EXTERNAL;
  8.  
  9.  PROCEDURE FinishUp(t:boolean);
  10.  EXTERNAL;
  11.  
  12.   PROCEDURE PutBin(c : character); { Output Binary }
  13.    BEGIN
  14.      IF (c = ENDFILE)
  15.       THEN
  16.      { flush buffer}
  17.      { fill with NULLS -- will be written below }
  18.      WHILE (bptr <= BLKSIZE) DO
  19.       BEGIN
  20.         binbuffer[bptr] := chr(NULLCHAR);
  21.         bptr := bptr + 1;
  22.       END;
  23.  
  24.       IF bptr > BLKSIZE
  25.        THEN
  26.     BEGIN
  27.       bfile^ := binbuffer;
  28.       put(bfile);
  29.       bptr := 1;
  30.       IF c <> ENDFILE THEN    
  31.           putbin(c);
  32.     END
  33.        ELSE
  34.     BEGIN
  35.       binbuffer[bptr] := chr(c);
  36.       bptr := bptr + 1;
  37.     END
  38.    END;
  39.  
  40.  
  41.  
  42.   { close (omsi) -- close a file }
  43.   PROCEDURE Sclose (fd : filedesc);
  44.    BEGIN
  45.      IF (fd >= STDERR) AND (fd <= MAXOPEN)
  46.       THEN
  47.        BEGIN
  48.      WITH openlist[fd] DO
  49.       BEGIN
  50.         IF (mode <= -IOREAD)
  51.          THEN
  52.           BEGIN
  53.         IF (mode = -IOWRITE)
  54.          THEN
  55.          putbin(ENDFILE);
  56.          { flush buffer }
  57.         close(bfile);
  58.         mode := IOERROR;
  59.           END
  60.          ELSE
  61.           BEGIN
  62.         close(filevar);
  63.         mode := IOAVAIL;
  64.           END
  65.       END;
  66.        END
  67.    END;
  68.  
  69.  
  70.   PROCEDURE ResetLine; { Reset DL11 Line }
  71.   EXTERNAL;
  72.  
  73.  
  74.   PROCEDURE ConUP; { Console upper case only }
  75.   EXTERNAL;
  76.  
  77.   { close all files on exit }
  78.   PROCEDURE closeall;
  79.   VAR
  80.     fd : filedesc;
  81.    BEGIN
  82.      FOR fd := STDERR TO MAXOPEN DO
  83.      Sclose(fd);
  84.      ResetLine;
  85.      ConUP;
  86.    END;
  87.  
  88.  
  89.  
  90.   { Open file in Binary Mode }
  91.   FUNCTION Obinary (VAR intname : string100; omode : integer) : filedesc;
  92.   VAR
  93.     len : integer;
  94.    BEGIN
  95.      IF (omode = -IOREAD)
  96.       THEN
  97.        BEGIN
  98.      reset(bfile, intname,'',len);
  99.      binbuffer  := bfile^;
  100.      bptr := 1;
  101.        END
  102.       ELSE
  103.        BEGIN
  104.      rewrite(bfile, intname);
  105.      bptr := 1;
  106.        END;
  107.      IF (omode = -IOREAD) AND (len <= 0)
  108.       THEN
  109.        BEGIN
  110.      sclose(BINARYFILE);
  111.      Obinary := IOERROR;
  112.        END
  113.       ELSE
  114.        BEGIN
  115.          Obinary := BINARYFILE;
  116.      openlist[BINARYFILE].mode := omode;
  117.        END;
  118.    END;
  119.  
  120.  
  121.   { open (RT-11) -- open a file for reading or writing }
  122.   FUNCTION Sopen (VAR name : string; omode : integer) : filedesc;
  123.   VAR
  124.     i ,len: integer;
  125.     intname : string100;
  126.     found : boolean;
  127.    BEGIN
  128.      i := 1;
  129.      WHILE (name[i] <> ENDSTR) AND (name[i] <> NEWLINE) DO
  130.       BEGIN
  131.     intname[i] := chr(name[i]);
  132.     i := i + 1
  133.       END;
  134.  
  135.      FOR i := i TO MAXSTR DO
  136.      intname[i] := ' ';      { pad name with blanks }
  137.  
  138.      IF (omode < IOERROR)
  139.       THEN
  140.       Sopen := obinary(intname,omode)
  141.       ELSE
  142.        BEGIN
  143.  
  144.      { find a free slot in openlist }
  145.      Sopen := IOERROR;
  146.      found := false;
  147.      i := 1;
  148.      WHILE (i <= MAXOPEN) AND (NOT found) DO
  149.       BEGIN
  150.         IF (openlist[i].mode = IOAVAIL)
  151.          THEN
  152.          WITH openlist[i] DO
  153.           BEGIN
  154.         mode := omode;
  155.         IF (mode = IOREAD)
  156.          THEN
  157.          reset(filevar, intname,'',len)
  158.          ELSE
  159.          IF (mode = IOWRITE)
  160.           THEN
  161.           rewrite(filevar, intname);
  162.  
  163.         IF (len <= 0) AND (mode=IOREAD)
  164.          THEN
  165.           BEGIN
  166.             Sclose(i);
  167.             Sopen := IOERROR
  168.           END
  169.          ELSE
  170.          Sopen:=i;
  171.  
  172.         found := true
  173.           END;
  174.         i := i + 1
  175.       END
  176.        END
  177.    END;
  178.  
  179.   { getcf (UCB) -- get one character from file }
  180.   FUNCTION getcf (VAR c: character; fd : filedesc) : character;
  181.   FORWARD;
  182.  
  183.   { getc (UCB) -- get one character from standard input }
  184.   FUNCTION getc (VAR c : character) : character;
  185.   VAR
  186.     ch : char;
  187.    BEGIN
  188.      IF (redirect[STDIN] = STDIN )
  189.       THEN
  190.        BEGIN
  191.      IF eof
  192.       THEN
  193.       c := ENDFILE
  194.       ELSE
  195.       IF eoln
  196.        THEN
  197.         BEGIN
  198.           readln;
  199.           c := NEWLINE
  200.         END
  201.        ELSE
  202.         BEGIN
  203.           read(ch);
  204.           c := ord(ch)
  205.         END;
  206.      getc := c
  207.        END
  208.       ELSE
  209.       getc := getcf(c,redirect[STDIN])
  210.    END;
  211.  
  212.  
  213.   PROCEDURE GETCL(VAR c : character;VAR t :integer);
  214.    { Get Character from DL11 Line }
  215.    { TimeLeft is also used }
  216.   EXTERNAL;
  217.  
  218.   PROCEDURE GetBin(VAR c: character); { Get Binary character }
  219.    BEGIN
  220.      IF bptr > BLKSIZE
  221.       THEN
  222.        BEGIN
  223.      get(bfile);
  224.      binbuffer := bfile^;
  225.      IF eof(bfile)
  226.       THEN
  227.       c := ENDFILE
  228.       ELSE
  229.        BEGIN
  230.          bptr := 1;
  231.          getbin(c);
  232.        END;
  233.        END
  234.       ELSE
  235.        BEGIN
  236.      c := ord(binbuffer[bptr]);
  237.      bptr := bptr + 1;
  238.        END
  239.    END;
  240.  
  241.   FUNCTION getcf; { Get Character from file }
  242.   VAR
  243.     ch : char;
  244.    BEGIN
  245.      IF (fd = STDIN)
  246.       THEN
  247.       getcf := getc(c)
  248.       ELSE WITH openlist[fd] DO
  249.       IF (mode = IOLINE)
  250.        THEN
  251.     BEGIN    
  252.       GETCL(c,TimeLeft);
  253.       { strip parity }
  254.       IF (parity <> oNONE) THEN
  255.         c := c AND 177B;
  256.     END
  257.        ELSE
  258.        IF (mode = -IOREAD)
  259.     THEN
  260.     GETBIN(c)
  261.     ELSE
  262.     IF eof(filevar)
  263.      THEN
  264.      c := ENDFILE
  265.      ELSE
  266.      IF eoln(filevar)
  267.       THEN
  268.        BEGIN
  269.          readln(filevar);
  270.          c := NEWLINE
  271.        END
  272.       ELSE
  273.        BEGIN
  274.          read(filevar, ch);
  275.          c := ord(ch)
  276.        END;
  277.      getcf := c
  278.    END;
  279.  
  280.   { getline (UCB) -- get a line from file }
  281.   FUNCTION getline (VAR s : string; fd : filedesc;
  282.             maxsize : integer) : boolean;
  283.   VAR
  284.     i : integer;
  285.     c : character;
  286.    BEGIN
  287.      i := 1;
  288.       REPEAT
  289.        s[i] := getcf(c, fd);
  290.        i := i + 1
  291.       UNTIL (c = ENDFILE) OR (c = NEWLINE) OR (i >= maxsize);
  292.      IF (c = ENDFILE)
  293.       THEN   { went one too far }
  294.       i := i - 1;
  295.      s[i] := ENDSTR;
  296.      getline := (c <> ENDFILE)
  297.    END;
  298.  
  299.   { putcf (UCB) -- put a single character on file fd }
  300.   PROCEDURE putcf (c : character; fd : filedesc);
  301.   FORWARD;
  302.  
  303.   { putc (UCB) -- put one character on standard output }
  304.   PROCEDURE putc (c : character);
  305.    BEGIN
  306.      IF (redirect[STDOUT] = STDOUT)
  307.       THEN
  308.       IF c = NEWLINE
  309.        THEN
  310.        writeln
  311.        ELSE
  312.        write(chr(c))
  313.       ELSE
  314.       putcf(c,redirect[STDOUT]);
  315.    END;
  316.  
  317.   PROCEDURE PUTCL(VAR c : character); { Output character to DL11 Line }
  318.   EXTERNAL;
  319.  
  320.   PROCEDURE putcf; { Put character to file }
  321.    BEGIN
  322.      IF (fd = STDOUT)
  323.       THEN
  324.       putc(c)
  325.       ELSE WITH openlist[fd] DO
  326.       IF (mode = IOLINE)
  327.        THEN
  328.        PUTCL(c)
  329.        ELSE
  330.        IF (mode = -IOWRITE)
  331.     THEN
  332.     PUTBIN(c)
  333.     ELSE
  334.     IF c = NEWLINE
  335.      THEN
  336.      writeln(filevar)
  337.      ELSE
  338.      write(filevar, chr(c))
  339.    END;
  340.  
  341.   { putstr (UCB) -- put out string on file }
  342.   PROCEDURE putstr (VAR s : string; f : filedesc);
  343.   VAR
  344.     i : integer;
  345.    BEGIN
  346.      i := 1;
  347.      WHILE (s[i] <> ENDSTR) AND (i < MAXSTR) DO
  348.       BEGIN
  349.     putcf(s[i], f);
  350.     i := i + 1
  351.       END
  352.    END;
  353.  
  354.   PROCEDURE Xbreak(VAR f : text); 
  355.     { As External since break is already defined }
  356.   EXTERNAL;
  357.  
  358.  
  359.   PROCEDURE Obreak(fd : filedesc);
  360.    BEGIN
  361.      IF (fd = STDOUT)
  362.       THEN
  363.       Xbreak(output)
  364.       ELSE
  365.       Xbreak(openlist[fd].filevar);
  366.    END;
  367.  
  368. PROCEDURE GTLINE(var commandLine : string80);
  369. BEGIN
  370.   write('KERMIT-RT> ');
  371.   Obreak(STDOUT);
  372.   readln(commandLine);
  373. END;
  374.  
  375.  
  376.   { itoc - convert integer n to char string in s[i]... }
  377.   FUNCTION itoc (n : integer; VAR s : string; i : integer) : integer; 
  378.      { returns end of s }
  379.    BEGIN
  380.      IF (n < 0)
  381.       THEN
  382.        BEGIN
  383.      s[i] := ord('-');
  384.      itoc := itoc(-n, s, i+1)
  385.        END
  386.       ELSE
  387.        BEGIN
  388.      IF (n >= 10)
  389.       THEN
  390.       i := itoc(n DIV 10, s, i);
  391.      s[i] := n MOD 10 + ord('0');
  392.      s[i+1] := ENDSTR;
  393.      itoc := i + 1
  394.        END
  395.    END;
  396.  
  397.   { length -- compute length of string }
  398.   FUNCTION length (VAR s : string) : integer;
  399.   VAR
  400.     n : integer;
  401.    BEGIN
  402.      n := 1;
  403.      WHILE (s[n] <> ENDSTR) DO
  404.      n := n + 1;
  405.      length := n - 1
  406.    END;
  407.  
  408.   { scopy -- copy string at src[i] to dest[j] }
  409.   PROCEDURE scopy (VAR src : string; i : integer;
  410.            VAR dest : string; j : integer);
  411.    BEGIN
  412.      WHILE (src[i] <> ENDSTR) DO
  413.       BEGIN
  414.     dest[j] := src[i];
  415.     i := i + 1;
  416.     j := j + 1
  417.       END;
  418.      dest[j] := ENDSTR
  419.    END;
  420.  
  421.   { index -- find position of character c in string s }
  422.   FUNCTION index (VAR s : string; c : character) : integer;
  423.   VAR
  424.     i : integer;
  425.    BEGIN
  426.      i := 1;
  427.      WHILE (s[i] <> c) AND (s[i] <> ENDSTR) DO
  428.      i := i + 1;
  429.      IF (s[i] = ENDSTR)
  430.       THEN
  431.       index := 0
  432.       ELSE
  433.       index := i
  434.    END;
  435.  
  436.  
  437.   PROCEDURE CtoS({ Using } x:cstring; { Returning } VAR s:string);
  438.     { convert constant to STIP string }
  439.   VAR
  440.     i : integer;
  441.    BEGIN
  442.      FOR i:=1 TO CONLENGTH DO
  443.      s[i] := ord(x[i]);
  444.      s[CONLENGTH+1] := ENDSTR;
  445.    END;
  446.  
  447.  
  448.   FUNCTION Exists({ Using }VAR s:string): { Returning } boolean;
  449.     { returns true if file exists }
  450.   VAR
  451.     fd: filedesc;
  452.     result: boolean;
  453.    BEGIN
  454.      fd  := Sopen(s,IOREAD);
  455.      result := (fd <> IOERROR);
  456.      Sclose(fd);
  457.      Exists := result;
  458.    END;
  459.  
  460.  
  461.  
  462.   FUNCTION nargs: integer; { returns number arguments }
  463.     { for RT - 11 }
  464.    BEGIN
  465.      nargs := cmdargs
  466.    END;
  467.  
  468.  
  469.   FUNCTION getarg(n:integer;VAR s:string;maxsize:integer): BOOLEAN;
  470.     { return the nth argument }
  471.     { RT - 11 }
  472.    BEGIN
  473.      IF ((n<1) OR (cmdargs<n))
  474.       THEN
  475.       getarg := false
  476.       ELSE
  477.        BEGIN
  478.      scopy(cmdlin,cmdidx[n],s,1);
  479.      getarg := true
  480.        END;
  481.    END;
  482.  
  483.  
  484.   PROCEDURE PutCon({ Using } x:cstring;
  485.            { Using } fd:filedesc);
  486.     { output literal }
  487.   VAR
  488.     s: string;
  489.    BEGIN
  490.      CtoS(x,s);
  491.      putstr(s,fd);
  492.      obreak(fd);
  493.    END;
  494.  
  495.   PROCEDURE PutCln({ Using } x:cstring;
  496.            { Using } fd:filedesc);
  497.     { output literal followed by NEWLINE }
  498.    BEGIN
  499.      PutCon(x,fd);
  500.      putcf(NEWLINE,fd);
  501.      obreak(fd);
  502.    END;
  503.  
  504.   PROCEDURE PutNum({ Using } n:integer;
  505.            { Using } fd:filedesc);
  506.     { Ouput number }
  507.   VAR
  508.     s: string;
  509.     dummy: integer;
  510.    BEGIN
  511.      s[1] := BLANK;
  512.      dummy := itoc(n,s,2);
  513.      putstr(s,fd);
  514.      obreak(fd);
  515.    END;
  516.  
  517.   PROCEDURE PutCS({ Using } x:cstring;
  518.           { Using } s : string;
  519.           { Using } fd:filedesc);
  520.     { output literal & string }
  521.    BEGIN
  522.      PutCon(x,fd);
  523.      putstr(s,fd);
  524.      putcf(NEWLINE,fd);
  525.      obreak(fd);
  526.    END;
  527.  
  528.   PROCEDURE PutCN({ Using } x:cstring;
  529.           { Using } v : integer;
  530.           { Using } fd:filedesc);
  531.     { output literal & number }
  532.    BEGIN
  533.      PutCon(x,fd);
  534.      PutNum(v,fd);
  535.      putcf(NEWLINE,fd);
  536.      obreak(fd);
  537.    END;
  538.  
  539.   { For KERMIT }
  540.  
  541.   PROCEDURE AddTo({ Updating } VAR sum : Stats;
  542.           { Using }  inc:integer);
  543.    BEGIN
  544.      sum := sum + inc;      
  545.    END;
  546.  
  547.  
  548.  
  549.   PROCEDURE PutPacket( p : Ppack); { Output Packet }
  550.   VAR
  551.     i : integer;
  552.    BEGIN
  553.      IF (Pad >0)
  554.       THEN
  555.       FOR i := 1 TO Pad DO
  556.       putcf(PadChar,LineOut);
  557.      WITH p^ DO
  558.       BEGIN
  559.     putcf(mark,LineOut);
  560.     putcf(count,LineOut);
  561.     putcf(seq,LineOut);
  562.     putcf(ptype,LineOut);
  563.     putstr(data,LineOut);
  564.       END;
  565.    END;
  566.  
  567.   FUNCTION GetIn { Returning } :character;  { get character }
  568.     { Should return NULL  ) if no characters }
  569.   VAR
  570.     c :character;
  571.    BEGIN
  572.      c := getcf(c,LineIn);
  573.      GetIn := c;
  574.  
  575.      IF (RunType = Receive) AND (c <> NULLCHAR)
  576.       THEN
  577.       AddTo(ChInPackRecv,1);
  578.  
  579.    END;
  580.  
  581.  
  582.   PROCEDURE StartTimer;
  583.    BEGIN
  584.      TimeLeft := TheirTimeOut * 60; { in ticks }
  585.    END;
  586.  
  587.   PROCEDURE StopTimer;
  588.    BEGIN
  589.      TimeLeft := MaxInt; { * 60 }
  590.    END;
  591.  
  592.   FUNCTION MakeChar({ Using } c:character): { Returning } character;
  593.     { convert integer to printable }
  594.    BEGIN
  595.      MakeChar := c + BLANK;
  596.    END;
  597.  
  598.   FUNCTION UnChar({ Using } c:character): { Returning } character;
  599.     { reverse of makechar }
  600.    BEGIN
  601.      UnChar := c - BLANK
  602.    END;
  603.  
  604.  
  605.   FUNCTION IsControl( c:character):  boolean;
  606.     { true if control }
  607.    BEGIN
  608.      { assume -128 .. 127 for characters }
  609.      IF (c >= NULLCHAR)
  610.       THEN
  611.       IsControl := (c=DEL ) OR (c < BLANK )
  612.       ELSE
  613.       IsControl := IsControl(c + 128);
  614.    END;
  615.  
  616.  
  617.  
  618.   FUNCTION Ctl( c:character):  character;
  619.     { c XOR 100 }
  620.    BEGIN
  621.      { assume -128 .. 127 for characters }
  622.      IF (c >= NULLCHAR)
  623.       THEN
  624.       IF (c < 64)
  625.        THEN
  626.        c := c + 64
  627.        ELSE
  628.        c := c - 64
  629.       ELSE
  630.       c := Ctl(c + 128) - 128;
  631.      Ctl := c;
  632.    END;
  633.  
  634.  
  635.   FUNCTION CheckFunction({ Using } c:integer): { Returning } character;
  636.     { calculate checksum }
  637.   VAR
  638.     x: integer;
  639.    BEGIN
  640.      {   CheckFunction := (c + ( c AND 300 ) /100 ) AND 77; }
  641.      x := (c MOD 256 ) DIV 64;
  642.      x := x + c;
  643.      CheckFunction := x MOD 64;
  644.    END;
  645.  
  646.   PROCEDURE EnCodeParm({ Updating } VAR data:string);  { encode parameters }
  647.   VAR
  648.     i: integer;
  649.    BEGIN
  650.      FOR i:=1 TO NUMPARAM DO
  651.      data[i] := BLANK;
  652.      data[NUMPARAM+1] := ENDSTR;
  653.      data[1] := MakeChar(SizeRecv);          { my biggest packet }
  654.      data[2] := MakeChar(MyTimeOut);         { when I want timeout}
  655.      data[3] := MakeChar(MyPad);             { how much padding }
  656.      data[4] := Ctl(MyPadChar);              { my padding character }
  657.      data[5] := MakeChar(myEOL);             { my EOL }
  658.      data[6] := MyQuote;                     { my quote char }
  659.  
  660.     { Handle 8 Bit Quoting - for transmit use our default }
  661.     
  662.      IF RunType = Transmit
  663.     THEN
  664.       data[7] := Def8QuoteMode          { Default mode  }
  665.     ELSE
  666.     { For receive -- these may have to be changed }
  667.       IF (QuoteForBinary = TYPEY) THEN  
  668.         IF (Def8QuoteMode <> TYPEY) THEN
  669.             BEGIN
  670.               BinaryMode := Quoted;
  671.               data[7] := DEF8CHAR;
  672.               QuoteForBinary := DEF8CHAR;
  673.             END
  674.         ELSE
  675.             BEGIN
  676.               BinaryMode := FullBinary;
  677.               data[7] := TYPEY;
  678.             END
  679.       ELSE IF (QuoteForBinary = TYPEN) THEN
  680.         data[7] := TYPEY
  681.       ELSE IF (QuoteForBinary = BLANK) THEN
  682.         data[7] := BLANK
  683.       ELSE 
  684.         data[7] := TYPEY;
  685.  
  686.     { Make sure that Quote Character is OK }
  687.     IF (RunType = Receive) AND (BinaryMode <> Quoted)
  688.         THEN 
  689.           QuoteForBinary := ENDSTR;
  690.  
  691.   END;
  692.  
  693.   PROCEDURE DeCodeParm({ Using } VAR data:string); { decode parameters }
  694.   VAR 
  695.     i,l : integer;
  696.    BEGIN
  697.      l := length(data);
  698.      IF l < NUMPARAM
  699.       THEN    
  700.     FOR i := l + 1 TO NUMPARAM DO
  701.         data[i] := BLANK;
  702.      data[NUMPARAM+1] := ENDSTR;
  703.      SizeSend := UnChar(data[1]);    { Packet Size }
  704.      TheirTimeOut := UnChar(data[2]);   { when I should time out }
  705.      Pad := UnChar(data[3]);            { padding characters to send  }
  706.      PadChar := Ctl(data[4]);           { padding character }
  707.      IF data[5] = BLANK 
  708.     THEN SendEOL := CR
  709.     ELSE SendEOL := UnChar(data[5]);{ EOL to send }
  710.      IF data[6] = BLANK
  711.     THEN SendQuote := SHARP
  712.     ELSE SendQuote := data[6];      { quote to send }
  713.      QuoteForBinary := data[7];        { 8 Bit Quote Character }
  714.  
  715.     { Change these if Full Binary not available }
  716.     { Use NotSupported if 'N' received          }
  717.  
  718.      IF QuoteForBinary = TYPEY THEN 
  719.           BinaryMode := FullBinary
  720.      ELSE IF QuoteForBinary = BLANK THEN 
  721.           BinaryMode := FullBinary
  722.      ELSE IF QuoteForBinary = TYPEN THEN
  723.           BinaryMode := NotSupported
  724.      ELSE
  725.           BinaryMode := Quoted;
  726.  
  727.     { Set it to quoted if we asked for it }
  728.      IF (RunType = Transmit) AND (QuoteForBinary = TYPEY) AND     
  729.     (Def8QuoteMode <> TYPEY) THEN
  730.     BEGIN
  731.       BinaryMode := Quoted;
  732.       QuoteForBinary := Def8QuoteMode;
  733.     END;
  734.  
  735.     { Make sure that Quote Character is OK }
  736.      IF (RunType = Transmit) AND (BinaryMode <> Quoted) THEN 
  737.           QuoteForBinary := ENDSTR;
  738.   END;
  739.  
  740.   { Externals for RT-11 }
  741.  
  742.   PROCEDURE ICON; { set up console }
  743.   EXTERNAL;
  744.  
  745.   PROCEDURE ITIME; { set up timer }
  746.   EXTERNAL;
  747.  
  748.   PROCEDURE RCON;  { Reset console }
  749.   EXTERNAL;
  750.  
  751.   PROCEDURE RTIME; { Reset Timer }
  752.   EXTERNAL;
  753.  
  754.   PROCEDURE Virtual; { Virtual terminal }
  755.   EXTERNAL;
  756.  
  757.   PROCEDURE SetLine; { Set up DL11 line }
  758.   EXTERNAL;
  759.  
  760.   PROCEDURE SYSinit; { special initialization }
  761.    BEGIN
  762.    END;
  763.  
  764.  
  765.   PROCEDURE SYSfinish; { System dependent }
  766.    BEGIN
  767.      RTIME;
  768.      RCON;
  769.    END;
  770.  
  771.   PROCEDURE StartRun; { initialization as necessary }
  772.    BEGIN
  773.      State := Init;              { send initiate is the start state }
  774.      NumTry := 0;                { say no tries yet }
  775.      RunTime := 0;
  776.  
  777.      NumSendPacks := 0;
  778.      NumRecvPacks := 0;
  779.      NumACK := 0;
  780.      NumNAK := 0;
  781.      NumACKrecv := 0;
  782.      NumNAKrecv := 0;
  783.      NumBADrecv := 0;
  784.      ChInFileSend := 0.0;
  785.      ChInPackSend := 0.0;
  786.      ChInFileRecv := 0.0;
  787.      ChInFileRecv := 0.0;
  788.  
  789.      ITIME;
  790.      ICON;
  791.  
  792.    END;
  793.  
  794.   PROCEDURE OpenPort;
  795.    BEGIN
  796.      IF InvalidConnection
  797.       THEN
  798.        BEGIN
  799.      InvalidConnection := false;
  800.      LineIn := DL11LINE;
  801.      LineOut := DL11LINE;
  802.      SetLine;
  803.        END;
  804.    END;
  805.  
  806.   PROCEDURE BadVTerminalConnect;
  807.    BEGIN;
  808.      writeln('Bad Terminal Connection');
  809.    END;
  810.  
  811.  
  812.   PROCEDURE MakeConnection;
  813.     { connect to remote }
  814.    BEGIN
  815.      writeln('[Connecting to remote host, Type CTRL-]C to return]');
  816.      Virtual;
  817.      writeln('[Connection closed, back at RT-11]'); 
  818.    END;
  819.  
  820.  
  821.   PROCEDURE DebugPacket({ Using }    mes : cstring;
  822.             { Using }  VAR p : Ppack);
  823.     { Print Debugging Info }
  824.    BEGIN
  825.      PutCon(mes,STDERR);
  826.      WITH p^ DO
  827.       BEGIN
  828.     PutNum(Unchar(count),STDERR);
  829.     PutNum(Unchar(seq),STDERR);
  830.     putcf(BLANK,STDERR);
  831.     putcf(ptype,STDERR);
  832.     putcf(NEWLINE,STDERR);
  833.     putstr(data,STDERR);
  834.     putcf(NEWLINE,STDERR);
  835.       END;
  836.    END;
  837.  
  838.  
  839.   PROCEDURE ReSendPacket;
  840.     { re -sends previous packet }
  841.    BEGIN
  842.      NumSendPacks := NumSendPacks+1;
  843.      AddTo(ChInPackSend,Pad + UnChar(LastPacket^.count) + 3);
  844.      IF Debug
  845.       THEN DebugPacket('Re-Sending ...      ',LastPacket);
  846.      PutPacket(LastPacket);
  847.    END;
  848.  
  849.  
  850.  
  851.   PROCEDURE SendPacket;
  852.     { expects count as length of data portion }
  853.     { and seq as number of packet }
  854.     { builds & sends packet }
  855.   VAR
  856.     i,len,chksum : integer;
  857.     temp : Ppack;
  858.    BEGIN
  859.      IF (NumTry <> 1) AND (RunType = Transmit )
  860.       THEN
  861.       ReSendPacket
  862.       ELSE
  863.        BEGIN
  864.      WITH ThisPacket^ DO
  865.       BEGIN
  866.         mark :=SOH;               { mark }
  867.         len := count;             { save length }
  868.         count := MakeChar(len+3); { count = 3+length of data }
  869.         seq := MakeChar(seq);     { seq number }
  870.         chksum := count + seq + ptype;
  871.         IF ( len > 0)
  872.          THEN      { is there data ? }
  873.          FOR i:= 1 TO len DO
  874.          IF (data[i] >= 0)
  875.           THEN
  876.           chksum := chksum + data[i]
  877.           ELSE
  878.           chksum := chksum + data[i] + 256;
  879.           { assume -128 .. 127 for characters }
  880.         chksum := CheckFunction(chksum);  { calculate  checksum }
  881.         data[len+1] := MakeChar(chksum);  { make printable & output }
  882.         IF OneWayOnly THEN
  883.         BEGIN
  884.               data[len+2] := CR;          { Use CRLF }
  885.               data[len+3] := NEWLINE;     
  886.               data[len+4] := ENDSTR;
  887.         END
  888.         ELSE
  889.         BEGIN
  890.               data[len+2] := SendEOL;          { EOL }
  891.               data[len+3] := ENDSTR;
  892.         END;
  893.       END;
  894.  
  895.  
  896.      NumSendPacks := NumSendPacks+1;
  897.      IF Debug
  898.       THEN DebugPacket('Sending ...         ',ThisPacket);
  899.  
  900.      PutPacket(ThisPacket);
  901.  
  902.      IF RunType = Transmit
  903.       THEN
  904.        BEGIN
  905.          AddTo(ChInPackSend,Pad + len + 6);
  906.          temp := LastPacket;
  907.          LastPacket := ThisPacket;
  908.          ThisPacket := temp;
  909.        END;
  910.        END
  911.    END;
  912.  
  913.  
  914.  
  915.   PROCEDURE SendACK({ Using } n:integer); { send ACK packet }
  916.    BEGIN
  917.      WITH ThisPacket^ DO
  918.       BEGIN
  919.     count := 0;
  920.     seq := n;
  921.     ptype := TYPEY;
  922.       END;
  923.      SendPacket;
  924.      NumACK := NumACK+1;
  925.    END;
  926.  
  927.   PROCEDURE SendNAK({ Using } n:integer); { send NAK packet }
  928.    BEGIN
  929.      WITH ThisPacket^ DO
  930.       BEGIN
  931.     count := 0;
  932.     seq := n;
  933.     ptype := TYPEN;
  934.       END;
  935.      SendPacket;
  936.      NumNAK := NumNAK+1;
  937.    END;
  938.  
  939.   PROCEDURE ErrorPack({ Using } c:cstring);
  940.     { output Error packet if necessary -- then exit }
  941.    BEGIN
  942.      IF Local
  943.       THEN
  944.       Putcln(c,STDERR);
  945.  
  946.       WITH ThisPacket^ DO
  947.       BEGIN
  948.         seq := n;
  949.         ptype := TYPEE;
  950.         CtoS(c,data);
  951.         count := length(data);
  952.       END;
  953.  
  954.      SendPacket;
  955.      FinishUp(false);
  956.      StipHalt;
  957.    END;
  958.  
  959.  
  960.  
  961.   PROCEDURE Verbose({ Using } c:cstring);
  962.     { Print message if verbosity }
  963.    BEGIN
  964.      IF Verbosity
  965.       THEN
  966.       Putcln(c,STDERR);
  967.    END;
  968.  
  969.  
  970.   PROCEDURE PutErr({ Using } c:cstring);
  971.     { Print error_messages }
  972.    BEGIN
  973.      IF Local
  974.       THEN
  975.       Putcln(c,STDERR);
  976.    END;
  977.  
  978. {$E-}  
  979. { Turn off Externals here }
  980.  
  981.   PROCEDURE Field1; { Count }
  982.   VAR
  983.     test: boolean;
  984.    BEGIN
  985.      WITH NextPacket^ DO
  986.       BEGIN
  987.     count := UnChar(t);
  988.     test := (count >= 3) OR (count <= SizeRecv-2);
  989.     InputPacket^.count := t;
  990.     IF NOT test
  991.      THEN
  992.      Verbose('Bad count           ');
  993.     isgood := isgood AND test;
  994.       END;
  995.    END;
  996.  
  997.   PROCEDURE Field2; { Packet Number }
  998.   VAR
  999.     test : boolean;
  1000.    BEGIN
  1001.      WITH NextPacket^ DO
  1002.       BEGIN
  1003.     seq := UnChar(t);
  1004.     test := (seq >= 0) OR (seq <= 63);
  1005.     InputPacket^.seq := t;
  1006.     IF NOT test
  1007.      THEN
  1008.      Verbose('Bad seq number      ');
  1009.     isgood := isgood AND test;
  1010.       END;
  1011.    END;
  1012.  
  1013.   PROCEDURE Field3; { Packet Type }
  1014.   VAR
  1015.     test : boolean;
  1016.    BEGIN
  1017.      WITH NextPacket^ DO
  1018.       BEGIN
  1019.     ptype := t;
  1020.     test := (t =TYPEB) OR (t=TYPED) OR (t=TYPEE) OR (t=TYPEF)
  1021.     OR (t=TYPEN) OR (t=TYPES) OR (t=TYPEY) OR (t=TYPEZ);
  1022.     InputPacket^.ptype := t;
  1023.     IF NOT test
  1024.      THEN
  1025.      Verbose('Bad Packet Type     ');
  1026.     isgood := isgood AND test;
  1027.       END;
  1028.    END;
  1029.  
  1030.   PROCEDURE ProcessQuoted; { for Data }
  1031.    BEGIN
  1032.      WITH NextPacket^ DO
  1033.       BEGIN
  1034.     IF (t=MyQuote) OR (t=QuoteForBinary)
  1035.      THEN    { character is quote }
  1036.       BEGIN
  1037.         IF control
  1038.          THEN        { quote ,quote  }
  1039.           BEGIN
  1040.         data[dataptr] := t + ishigh;
  1041.         dataptr := dataptr+1;
  1042.         control := false;
  1043.         ishigh := 0;
  1044.           END
  1045.          ELSE IF (t=MyQuote) THEN  { set control on }
  1046.             control := true
  1047.       END
  1048.      ELSE                 { not quote }
  1049.      IF control
  1050.       THEN      { convert to control }
  1051.        BEGIN
  1052.          data[dataptr] := ctl(t) + ishigh;
  1053.          dataptr := dataptr+1;
  1054.          control := false;
  1055.          ishigh := 0;        
  1056.        END
  1057.       ELSE      { regular data }
  1058.        BEGIN
  1059.          data[dataptr] := t + ishigh;
  1060.          dataptr := dataptr+1;
  1061.          ishigh := 0;    
  1062.        END;
  1063.       END;
  1064.    END;
  1065.  
  1066.   PROCEDURE Field4; { Data }
  1067.    BEGIN
  1068.      PacketPtr := PacketPtr+1;
  1069.      InputPacket^.data[PacketPtr] := t;
  1070.      WITH NextPacket^ DO
  1071.       BEGIN
  1072.     IF ((ptype = TYPES) or (ptype = TYPEY))
  1073.      THEN
  1074.        BEGIN
  1075.          data[dataptr] := t;
  1076.          dataptr := dataptr+1;
  1077.        END
  1078.     ELSE 
  1079.        BEGIN
  1080.          IF (BinaryMode = Quoted) THEN     
  1081.         BEGIN { has it been quited ?}
  1082.           IF (NOT control) AND (t = QuoteForBinary)
  1083.             THEN ishigh := 128
  1084.           ELSE
  1085.             ProcessQuoted;  
  1086.         END
  1087.          ELSE
  1088.            ProcessQuoted;  { do regular quoting }        
  1089.        END;
  1090.       END;
  1091.    END;
  1092.  
  1093.   PROCEDURE Field5; { Check Sum }
  1094.   VAR
  1095.     test : boolean;
  1096.    BEGIN
  1097.      WITH InputPacket^ DO
  1098.       BEGIN
  1099.     PacketPtr := PacketPtr +1;
  1100.     data[PacketPtr] := t;
  1101.     PacketPtr := PacketPtr +1;
  1102.     data[PacketPtr] := ENDSTR;
  1103.       END;
  1104.      { end of input string }
  1105.      check := CheckFunction(check);
  1106.      check := MakeChar(check);
  1107.      test := (t=check);
  1108.      isgood := isgood AND test;
  1109.      NextPacket^.data[dataptr] := ENDSTR;
  1110.      { end of data string }
  1111.      finished := true;  { set finished }
  1112.    END;
  1113.  
  1114.   PROCEDURE BuildPacket;
  1115.     { receive packet & validate checksum }
  1116.   VAR
  1117.     temp : Ppack;
  1118.    BEGIN
  1119.      WITH NextPacket^ DO
  1120.       BEGIN
  1121.     IF restart
  1122.      THEN
  1123.       BEGIN
  1124.         { read until get SOH marker }
  1125.         IF  (t = SOH)
  1126.          THEN
  1127.           BEGIN
  1128.         finished := false;    { set varibles }
  1129.         control := false;
  1130.         ishigh := 0;          { no shift }
  1131.         isgood := true;
  1132.         seq := -1;       { set return values to bad packet }
  1133.         ptype := QUESTION;
  1134.         data[1] := ENDSTR;
  1135.         data[MAXSTR] := ENDSTR;
  1136.  
  1137.         restart := false;
  1138.         fld := 0;
  1139.         dataptr := 1;
  1140.         PacketPtr := 0;
  1141.         check := 0;
  1142.           END;
  1143.       END
  1144.      ELSE                          { have started packet }
  1145.       BEGIN
  1146.         IF (t=SOH)          { check for restart or EOL }
  1147.          THEN
  1148.          restart := true
  1149.          ELSE
  1150.          IF (t=myEOL)
  1151.           THEN
  1152.            BEGIN
  1153.          finished := true;
  1154.          isgood := false;
  1155.            END
  1156.           ELSE
  1157.            BEGIN
  1158.          CASE fld OF
  1159.            { increment field number }
  1160.            0:   fld := 1;
  1161.            1:   fld := 2;
  1162.            2:   fld := 3;
  1163.            3:
  1164.            IF (count=3)  { no data }
  1165.             THEN
  1166.             fld := 5
  1167.             ELSE
  1168.             fld := 4;
  1169.            4:
  1170.            IF (PacketPtr>=count-3) { end of data }
  1171.             THEN
  1172.             fld := 5;
  1173.           END { case };
  1174.  
  1175.          IF (fld<>5)
  1176.           THEN
  1177.           check := check+t; { add into checksum }
  1178.  
  1179.          CASE fld OF
  1180.            1:      Field1;
  1181.            2:      Field2;
  1182.            3:      Field3;
  1183.            4:      Field4;
  1184.            5:      Field5;
  1185.           END;
  1186.          { case }
  1187.            END;
  1188.       END;
  1189.  
  1190.     IF finished
  1191.      THEN
  1192.       BEGIN
  1193.         IF (ptype=TYPEE)  AND isgood
  1194.          THEN   { error_packets }
  1195.           BEGIN
  1196.         IF Local
  1197.          THEN
  1198.          putstr(data,STDERR);
  1199.         putcf(NEWLINE,STDERR);
  1200.         FinishUp(false);
  1201.         StipHalt;
  1202.           END;
  1203.  
  1204.         NumRecvPacks := NumRecvPacks+1;
  1205.         IF Debug
  1206.          THEN
  1207.           BEGIN
  1208.         DebugPacket('Received ...        ',InputPacket);
  1209.         IF isgood
  1210.          THEN
  1211.          PutCln('Is Good             ',STDERR);
  1212.           END;
  1213.  
  1214.         temp := CurrentPacket;
  1215.         CurrentPacket := NextPacket;
  1216.         NextPacket := temp;
  1217.       END;
  1218.       END;
  1219.    END;
  1220.  
  1221. {$E+}
  1222. { Turn on Externals here }
  1223.  
  1224.   FUNCTION RecvPacket: boolean;
  1225.    BEGIN
  1226.      StartTimer;
  1227.      finished := false;
  1228.      restart := true;
  1229.      FromConsole := nothing;  { No Interupt }
  1230.       REPEAT
  1231.        t := GetIn;
  1232.        IF Local   { check Interupt }
  1233.     THEN
  1234.     CASE FromConsole OF
  1235.       abortnow:
  1236.        BEGIN
  1237.          ErrorPack('Aborting Transfer   ');
  1238.        END;
  1239.       nothing:        { nothing };
  1240.       CRin:
  1241.        BEGIN
  1242.          t := MyEOL;
  1243.          FromConsole := nothing;
  1244.        END;
  1245.      END;
  1246.     { case }
  1247.        IF (t <> NULLCHAR)
  1248.     THEN
  1249.     BuildPacket;
  1250.       UNTIL finished  OR (TimeLeft <= 0);
  1251.      IF (TimeLeft <= 0)
  1252.       THEN
  1253.        BEGIN
  1254.      CurrentPacket^.ptype := TYPET;
  1255.      restart := true;
  1256.      isgood := true;
  1257.      Verbose('Timed Out           ')
  1258.        END;
  1259.      StopTimer;
  1260.      RecvPacket := isgood;
  1261.    END;
  1262.  
  1263.   FUNCTION RecvACK : { Returning } boolean;
  1264.     { receive ACK with correct number }
  1265.   VAR
  1266.     Ok: boolean;
  1267.    BEGIN
  1268.      IF (NOT OneWayOnly )
  1269.       THEN
  1270.       Ok := RecvPacket;
  1271.      WITH CurrentPacket^ DO
  1272.       BEGIN
  1273.     IF (ptype=TYPEY)
  1274.      THEN
  1275.      NumACKrecv := NumACKrecv+1
  1276.      ELSE
  1277.      IF (ptype=TYPEN)
  1278.       THEN
  1279.       NumNAKrecv := NumNAKrecv+1
  1280.       ELSE
  1281.       IF NOT OneWayOnly
  1282.        THEN
  1283.        NumBadrecv := NumBadrecv +1;
  1284.        { got right one ? }
  1285.     RecvACK := ( Ok AND (ptype=TYPEY) AND (n=seq))
  1286.                  OR  ( OneWayOnly)
  1287.       END;
  1288.    END;
  1289.  
  1290.  
  1291.  
  1292.  
  1293.