home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / intelrmx86 / conn.p86 < prev    next >
Text File  |  2020-01-01  |  3KB  |  113 lines
  1. $compact
  2. $optimize(3)
  3.  
  4. conn$module:
  5. do;
  6.  
  7. /* CONNECT: Establish a "virtual terminal" connection through a         */
  8. /* specified serial i/o port.  */
  9.  
  10. $INCLUDE(:INC:LTKSEL.LIT)
  11.  
  12. declare status word external;
  13. declare (in$conn,out$conn) token external;
  14. declare (ci$conn,co$conn) token external;
  15. declare debug byte external;
  16.  
  17. declare break literally '1DH';
  18. declare ctly  literally '19H';  /* ^C by typing ^]^Y */
  19. declare ctlq  literally '11H';
  20. declare ctls  literally '13H';
  21. declare ctlc  literally '03H';
  22. declare true  literally '0FFH';
  23. declare false literally '00H';
  24. declare null  literally '0';
  25. declare cr    literally '0DH';
  26. declare lf    literally '0AH';
  27. declare crlf  literally 'cr,lf,null';
  28.  
  29. $INCLUDE(:INC:UREAD.EXT)
  30. $INCLUDE(:INC:UWRITE.EXT)
  31.  
  32. declare iobuff(1024) byte public;
  33.  
  34. check$error: procedure(fatal) byte external;
  35.     declare fatal byte;
  36. end check$error;
  37.  
  38. print:    procedure(msg) external;
  39.     declare msg pointer;
  40. end print;
  41.  
  42. newline: procedure external; end newline;
  43.  
  44. sbreak: procedure byte external;
  45. end sbreak;
  46.  
  47. send$setup: procedure external;
  48. end send$setup;
  49.  
  50. connect:
  51.     procedure public;
  52.     declare (c,i,qbreak) byte;
  53.  
  54.     qbreak=false;
  55.     if debug then
  56.       do;
  57.         call print(@('connecting to serial port $'));
  58. /* something about which terminal line */
  59.         call newline;
  60.         call print(@('to exit CONNECT mode type ^] C$'));
  61.         call newline;
  62.       end;
  63.         do while (1);
  64.         c=DQ$READ(ci$conn,@iobuff,80,@status);
  65.         if check$error(0) then return;
  66. loop:        if c>0 then do;
  67.           if qbreak then do;
  68.             qbreak=false;
  69.             if iobuff(0)='C' then return;
  70.             else if iobuff(0)='c' then return;
  71.             else if iobuff(0)=ctly then iobuff(0)=ctlc;
  72.             else if iobuff(0)='0' then iobuff(0)=null;
  73.             else if iobuff(0)='?' then do;
  74.                 call print(@('Special characters are: B,C,?,^Y,0',crlf));
  75.                 c=c-1;
  76.                 if i>0 then call movb(@iobuff(1),@iobuff(0),c);
  77.                 goto loop;
  78.                 end;
  79.             else if (iobuff(0)='B' or iobuff(0)='b') then do;
  80.                 call send$setup;
  81.                 i=sbreak;
  82.                 c=c-1;
  83.                 if i>0 then call movb(@iobuff(1),@iobuff(0),c);
  84.                 goto loop;
  85.                 end;
  86. /*  add check for other characters.....otherwise ignore */
  87.           end;
  88.           do i=0 to c-1;
  89.             if iobuff(i)=break then do;
  90.               if i>0 then do;
  91.                 call DQ$WRITE(out$conn,@iobuff,i,@status);
  92.                 if check$error(0) then return;
  93.               end;
  94.               c=c-i-1;
  95.               if c>0 then call movb(@iobuff(i+1),@iobuff,c);
  96.               qbreak=true;
  97.               goto loop;
  98.             end;
  99.           end;
  100.           call DQ$WRITE(out$conn,@iobuff,c,@status);
  101.           if check$error(0) then return;
  102.         end;
  103.         c=DQ$READ(in$conn,@iobuff,40,@status);
  104.         if check$error(0) then return;
  105.         if c>0 then do;
  106.           call DQ$WRITE(co$conn,@iobuff,c,@status);
  107.           if check$error(0) then return;
  108.         end;
  109.       end;
  110. end connect;
  111.  
  112. end conn$module;
  113.