home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / intelrmx86 / kermit.p86 < prev    next >
Text File  |  2020-01-01  |  21KB  |  887 lines
  1. $compact
  2. $optimize(3)
  3. kermit:
  4. do;
  5.  
  6. declare true literally '0FFH';
  7. declare false literally '00H';
  8. $INCLUDE(:INC:LTKSEL.LIT)
  9. $INCLUDE(:INC:NEXCEP.LIT)
  10. $INCLUDE(:INC:IEXCEP.LIT)
  11.  
  12. declare null literally '000H';
  13. declare lf literally '0AH';
  14. declare cr literally '0DH';
  15. declare crlf literally 'cr,lf,null';
  16. declare space literally '20H';
  17. declare dollar literally '24H';
  18. declare soh literally '1';
  19.  
  20. declare term$attr structure
  21.     (num$words        word,
  22.      num$used        word,
  23.      connect$flag    word,
  24.      terminal$flag    word,
  25.      in$baud$rate    word,
  26.      out$baud$rate    word,
  27.      scroll$lines    word,
  28.      x$y$size        word,
  29.      x$y$offset        word,
  30.      flow$control    word,
  31.      high$water$mark word,
  32.      low$water$mark    word,
  33.      fc$on$char        word,
  34.      fc$off$char    word);
  35. declare fdata structure(
  36.     len$owner    byte,
  37.     owner(14)    byte,
  38.     length        dword,
  39.     type        byte,
  40.     owner$access byte,
  41.     world$access byte,
  42.     create$time    dword,
  43.     last$mod$time dword,
  44.     reserved(20)    byte);
  45. declare file$len (2) word PUBLIC AT (@fdata.length);
  46. declare file$truncate byte;
  47.  
  48. declare buflen literally '122';
  49. declare buffer(buflen) byte PUBLIC;
  50. declare outbuf(buflen) byte;
  51. declare takebuf(buflen) byte;
  52. declare cmdstr(buflen) byte PUBLIC;
  53. declare query_in(10) byte;
  54. declare outlen word;
  55. declare trans_wait word public;
  56. declare status word public;
  57. declare old_baud_in word;
  58. declare old_baud_ci word;
  59. declare dev_attach byte;
  60. declare server$mode byte public;
  61. declare baud_rate word PUBLIC;
  62. declare block_check byte public;
  63. declare duplex byte PUBLIC;
  64. declare break_char byte public;
  65. declare parity byte public;
  66. declare delim byte public;
  67. declare len word;
  68.  
  69. declare send$delay byte public;
  70. declare send$eol byte public;
  71. declare send$paclen byte public;
  72. declare send$padchar byte public;
  73. declare send$padding byte public;
  74. declare send$pause byte public;
  75. declare send$quote byte public;
  76. declare send$start byte public;
  77. declare send$time byte public;
  78. declare recv$eol byte public;
  79. declare recv$paclen byte public;
  80. declare recv$padchar byte public;
  81. declare recv$padding byte public;
  82. declare recv$pause byte public;
  83. declare recv$quote byte public;
  84. declare recv$start byte public;
  85. declare recv$time byte public;
  86. declare send$setup$string(6) byte public;
  87.  
  88. declare cmd byte public;
  89. declare in$conn token public;
  90. declare out$conn token public;
  91. declare ci$conn token public;
  92. declare co$conn token public;
  93.  
  94. declare filestr  structure
  95.     (len byte,
  96.      name(80) byte);
  97. declare filename structure
  98.     (len byte,
  99.      name(80) byte) public;
  100. declare file$conn token public;
  101. declare takename structure
  102.     (len byte,
  103.      name(80) byte);
  104. declare take$conn token;
  105. declare takelen byte initial (0);
  106. declare takeindex byte initial (0);
  107.  
  108. declare debug byte public;
  109. declare qopen byte public;
  110.  
  111. declare iobuff(1024) byte external;
  112.  
  113. /* here are the subroutines */
  114.  
  115. $INCLUDE(:INC:HGTIPN.EXT)
  116. $INCLUDE(:INC:HSTPBF.EXT)
  117. $INCLUDE(:INC:UFLINF.EXT)
  118. $INCLUDE(:INC:UATACH.EXT)
  119. $INCLUDE(:INC:UOPEN.EXT)
  120. $INCLUDE(:INC:UCLOSE.EXT)
  121. $INCLUDE(:INC:UWRITE.EXT)
  122. $INCLUDE(:INC:UDCEX.EXT)
  123. $INCLUDE(:INC:UCREAT.EXT)
  124. $INCLUDE(:INC:UDCTIM.EXT)
  125. $INCLUDE(:INC:UDETAC.EXT)
  126. $INCLUDE(:INC:ISSPEC.EXT)
  127. $INCLUDE(:INC:USPECL.EXT)
  128. $INCLUDE(:INC:USWBF.EXT)
  129. $INCLUDE(:INC:UREAD.EXT)
  130. $INCLUDE(:INC:UEXIT.EXT)
  131. $INCLUDE(:INC:UGTARG.EXT)
  132. $INCLUDE(:INC:UTRUNC.EXT)
  133.  
  134. connect:
  135.     procedure external;
  136. end connect;
  137.  
  138. spar: procedure (a) external;
  139.     declare a address;
  140. end spar;
  141.  
  142. rpar: procedure (a) external;
  143.     declare a address;
  144. end rpar;
  145.  
  146. do$put:    procedure(conn) external;
  147.     declare conn token;
  148. end do$put;
  149.  
  150. send:     procedure byte external;
  151. end send;
  152.  
  153. bye: procedure byte external;
  154. end bye;
  155.  
  156. finish: procedure byte external;
  157. end finish;
  158.  
  159. get: procedure byte external;
  160. end get;
  161.  
  162. recv:    procedure byte external;
  163. end recv;
  164.  
  165. trans: procedure byte external;
  166. end trans;
  167.  
  168. check$error: PROCEDURE (fatal) byte PUBLIC;
  169.     declare fatal byte;
  170.     declare dummy word;
  171.     declare exc$buf structure(
  172.         count byte,
  173.         char(80) byte);
  174.     if status <> E$OK then do;
  175.       call DQ$DECODE$EXCEPTION(status,@exc$buf,@dummy);
  176.       call DQ$WRITE(co$conn,@exc$buf.char,exc$buf.count,@dummy);
  177.       call DQ$WRITE(co$conn,@(cr,lf),2,@dummy);
  178.       if fatal<>0 then call exit$cmd(3);
  179.       return true;
  180.     end;
  181.     return false;
  182. end check$error;
  183.  
  184. declare digit word;
  185. declare numbuf(20) byte;
  186. declare index byte;
  187.  
  188. nout:    procedure(n) public;
  189.     declare n word;
  190.  
  191.     if n = 0 then
  192.       do;
  193.         call co('0');
  194.         return;
  195.       end;
  196.     index = 1;
  197.     do while (n > 0);
  198.       digit = n mod 10;
  199.       numbuf(index) = digit+030H;
  200.       index = index + 1;
  201.       n = n / 10;
  202.     end;
  203.     do while ((index := index - 1) > 0);
  204.       call co(numbuf(index));
  205.     end;
  206. end nout;
  207.  
  208. noutd: procedure(n) public;
  209.     declare n dword;
  210.  
  211.     if n = 0 then
  212.       do;
  213.         call co('0');
  214.         return;
  215.       end;
  216.     index = 1;
  217.     do while (n > 0);
  218.       digit = n mod 10;
  219.       numbuf(index) = digit+030H;
  220.       index = index + 1;
  221.       n = n / 10;
  222.     end;
  223.     do while ((index := index - 1) > 0);
  224.       call co(numbuf(index));
  225.     end;
  226. end noutd;
  227.  
  228. nin:    procedure(string) address public;
  229.     declare string address;
  230.     declare result address;
  231.     declare c based string byte;
  232.  
  233.     result = 0;
  234.     if (string <> 0) then do;
  235.       do while (c >= 030H) and (c <= 039H);
  236.         result = result * 10 + (c - 030H);
  237.         string = string + 1;
  238.       end;
  239.     end;
  240.     return result;
  241. end nin;
  242.  
  243. co: procedure(c) public;
  244.     declare c byte;
  245.     outbuf(outlen)=c;
  246.     outlen=outlen+1;
  247.     if outlen>50 then do;
  248.         call DQ$WRITE(co$conn,@outbuf,outlen,@status);
  249.         if check$error(1) then return;
  250.         outlen=0;
  251.         end;
  252.     end co;
  253.  
  254. do$co: procedure public;
  255.     if outlen>0 then do;
  256.         call DQ$WRITE(co$conn,@outbuf,outlen,@status);
  257.         if check$error(1) then return;
  258.         outlen=0;
  259.         end;
  260.     return;
  261. end do$co;
  262.  
  263. newline: procedure public;
  264.     outbuf(outlen)=cr;
  265.     outbuf(outlen+1)=lf;
  266.     call DQ$WRITE(co$conn,@outbuf,outlen+2,@status);
  267.     if check$error(1) then return;
  268.     outlen=0;
  269. end newline;
  270.  
  271. prints:    procedure(msg) public;
  272.     declare msg pointer;
  273.     declare buff BASED msg structure
  274.         (len byte,
  275.          msg byte);
  276.     call do$co;
  277.     call DQ$WRITE(co$conn,@buff.msg,buff.len,@status);
  278.     if check$error(1) then return;
  279.     return;
  280. end prints;
  281.  
  282. print:    procedure(msg) public;
  283.     declare (msg,oldmsg) pointer;
  284.     declare c based msg (1) byte;
  285.     declare i word;
  286.  
  287.     call do$co;
  288.     oldmsg=msg;
  289.     i=0;
  290.     do while (c(i) > 0) and (c(i) <> '$');
  291.       if c(i) = '\' then do;
  292.         if i>0 then do;
  293.           call DQ$WRITE(co$conn,oldmsg,i,@status);
  294.           if check$error(1) then return;
  295.           end;
  296.         call DQ$WRITE(co$conn,@(cr,lf),2,@status);
  297.         if check$error(1) then return;
  298.         oldmsg=@c(i+1);
  299.         i=0;
  300.         msg=oldmsg;
  301.         end;
  302.       else i=i+1;
  303.         end;
  304.     if i>0 then do;
  305.         call DQ$WRITE(co$conn,oldmsg,i,@status);
  306.         if check$error(1) then return;
  307.     end;
  308. end print;
  309.  
  310. set$term$attr: procedure(qdefault);
  311.     declare qdefault byte;
  312.     declare c byte;
  313.     declare save$conn$flag word;
  314.     declare save$term$flag word;
  315.     if qdefault then do;
  316. /* here restore normal terminal attributes */
  317.       term$attr.connect$flag=save$conn$flag;
  318.       term$attr.terminal$flag=save$term$flag;
  319.     end;
  320.     else do;
  321. /* here set kermit terminal attributes */
  322.       save$conn$flag=term$attr.connect$flag;
  323.       save$term$flag=term$attr.terminal$flag;
  324.       term$attr.connect$flag=term$attr.connect$flag OR 7;
  325.       if parity=4 then do;
  326.         term$attr.connect$flag=term$attr.connect$flag OR 18H;
  327.         term$attr.terminal$flag=(term$attr.terminal$flag OR 1F0H) xor 0E0H;
  328.       end;
  329.       else call print(@('Unsupported parity specified',crlf));
  330.       if duplex then
  331.         term$attr.terminal$flag=term$attr.terminal$flag OR 2;
  332.       else
  333.         term$attr.terminal$flag=term$attr.terminal$flag AND 0FFFDH;
  334.     end;
  335.     call RQ$S$SPECIAL(in$conn,5,@term$attr,0,@status);
  336.     if check$error(1) then return;
  337.     if NOT qdefault then do;
  338. /* PURGE ANY INPUT QUEUED UP */
  339.       c=1;
  340.       do while c<>0;
  341.         c=DQ$READ(in$conn,@iobuff,127,@status);
  342.         if check$error(1) then return;
  343.       end;
  344.     end;
  345. end set$term$attr;
  346.  
  347. get$term$attr: procedure;
  348.     call RQ$S$SPECIAL(in$conn,4,@term$attr,0,@status);
  349.     if check$error(1) then return;
  350.     if debug then do;
  351.       call print(@('conn_flag ',null));
  352.       call nout(term$attr.connect$flag);
  353.       call print(@(' term_flag ',null));
  354.       call nout(term$attr.terminal$flag);
  355.       call newline;
  356.       call print(@('baud rate in/out ',null));
  357.       call nout(term$attr.in$baud$rate);
  358.       call co(' ');
  359.       call nout(term$attr.out$baud$rate);
  360.       call newline;
  361.       call print(@('flow control ',null));
  362.       call nout(term$attr.flow$control);
  363.       call newline;
  364.     end;
  365.     return;
  366. end get$term$attr;
  367.  
  368. /* IOINIT:          */
  369.  
  370. ioinit:    procedure;
  371.     ci$conn=DQ$ATTACH(@(4,':CI:'),@status);
  372.     co$conn=DQ$ATTACH(@(4,':CO:'),@status);
  373.     call DQ$OPEN(ci$conn,1,2,@status);
  374.     call DQ$OPEN(co$conn,2,0,@status);
  375.     if debug then CALL DQ$WRITE(co$conn,
  376.                   @('openned consol for I/O',cr,lf),24,@status);
  377.     in$conn=ci$conn;
  378.     out$conn=co$conn;
  379.     call get$term$attr;
  380.     call print(@('Default communication thru :CI:/:CO:',crlf));
  381. end ioinit;
  382.  
  383. file$open: procedure (mode) PUBLIC;
  384.     declare mode byte;
  385.     file$conn=DQ$ATTACH(@filename,@STATUS);
  386.     file$truncate=false;
  387.     if mode=2 then do;
  388.       if status=E$FNEXIST then
  389.         file$conn=DQ$CREATE(@filename,@status);
  390.       else if status=E$OK then do;
  391.         call print(@('About to overwrite file ',null));
  392.         call prints(@filename);
  393.         call print(@(', please confirm',null));
  394.         if NOT query then return;
  395.         file$truncate=true;
  396.       end;
  397.     end;
  398.     if check$error(0) then return;
  399.     call DQ$OPEN(file$conn,mode,2,@status);
  400.     if check$error(0) then return;
  401.     if mode=1 then do;
  402.       call DQ$FILE$INFO(file$conn,0,@fdata,@status);
  403.       if check$error(0) then return;
  404.     end;
  405.     qopen=true;
  406.     return;
  407. end file$open;
  408.  
  409. file$close: procedure public;
  410.     if qopen then do;
  411.       if file$truncate then do;
  412.         call DQ$TRUNCATE(file$conn,@status);
  413.         if check$error(0) then return;
  414.       end;
  415.       call DQ$CLOSE(file$conn,@status);
  416.       if check$error(0) then return;
  417.       call DQ$DETACH(file$conn,@status);
  418.       if check$error(0) then return;
  419.       qopen=false;
  420.     end;
  421. end file$close;
  422.  
  423. return$to$ci: procedure;
  424.    if in$conn <> ci$conn then do;
  425.      call close$in;
  426.      in$conn=ci$conn;
  427.      out$conn=co$conn;
  428.      call get$term$attr;
  429.      old_baud_in=term$attr.in$baud$rate;
  430.      call print(@('set connection via :CI:/:CO:',crlf));
  431.      if baud_rate<>0 then do;
  432.       if term$attr.in$baud$rate<>baud_rate then do;
  433.         call print(@('you are about to change the CI/CO baud rate',
  434.             ', please confirm:',null));
  435.         if query then do;
  436.           term$attr.in$baud$rate=baud_rate;
  437.           call RQ$S$SPECIAL(in$conn,5,@term$attr,0,@status);
  438.           if check$error(1) then return;
  439.         end;
  440.         else baud_rate=0;
  441.       end;
  442.      end;
  443.    end;
  444. end return$to$ci;
  445.  
  446. close$in: procedure;
  447.     if baud_rate <> 0 then do;
  448.       if term$attr.in$baud$rate <> old_baud_in then do;
  449.         term$attr.in$baud$rate=old_baud_in;
  450.         call RQ$S$SPECIAL(in$conn,5,@term$attr,0,@status);
  451.         if check$error(1) then return;
  452.       end;
  453.     end;
  454.     call DQ$CLOSE(in$conn,@status);
  455.     if check$error(0) then return;
  456.     call DQ$DETACH(in$conn,@status);
  457.     if check$error(0) then return;
  458. end close$in;
  459.  
  460. query: procedure byte public;
  461.     cmd=DQ$READ(ci$conn,@query_in,10,@status);
  462.     if check$error(0) then return false;
  463.     if query_in(0)='y' or query_in(0)='Y' then return true;
  464.     return false;
  465. end query;
  466.  
  467. get$line: procedure byte;
  468.     declare i byte;
  469.     len=0;
  470.     takeindex=takeindex+1;
  471. loop:
  472.     if takeindex>=takelen then do;
  473.         takelen=DQ$READ(take$conn,@takebuf,120,@status);
  474.         if check$error(0) then return 0;
  475.         takeindex=0;
  476.         if takelen=0 then return 0;
  477.     end;
  478.     do i=takeindex to takelen-1;
  479.         buffer(len)=takebuf(i);
  480.         if debug then call co(takebuf(i));
  481.         if takebuf(i) <> lf then len=len+1;
  482.         if takebuf(i)=cr then do;
  483.             if debug then call do$co;
  484.             takeindex=i;
  485.             return len;
  486.         end;
  487.     end;
  488.     takeindex=takelen;
  489.     goto loop;
  490. end get$line;
  491.  
  492. readln: procedure;
  493.     declare len word;
  494.     len=DQ$READ(ci$conn,@buffer,120,@status);
  495.     if check$error(1) then return;
  496.     len=DQ$SWITCH$BUFFER(@buffer,@status);
  497.     if check$error(1) then return;
  498. end readln;
  499.  
  500. bye$cmd: procedure PUBLIC;
  501.     if in$conn=ci$conn then do;
  502.       call print(@('can not send bye to yourself...use SET cmd first',
  503.         crlf));
  504.       return;
  505.     end;
  506.     call set$term$attr(false);
  507.     if bye then call exit$cmd(3);
  508.     else call print(@('Error shutting down remote KERMIT',crlf));
  509.     call set$term$attr(true);
  510. end bye$cmd;
  511.  
  512. conn$cmd: procedure PUBLIC;
  513.     if delim<>cr then call port$para;
  514.     if in$conn=ci$conn then do;
  515.       call print(@('can not connect to yourself...use SET cmd first',
  516.         crlf));
  517.       return;
  518.     end;
  519.     call DQ$SPECIAL(3,@ci$conn,@status);
  520.     if check$error(1) then return;
  521.     call set$term$attr(false);
  522.     if term$attr.in$baud$rate>4000 then
  523.       call print(@('Warning..at present BAUD rate characters',
  524.             ' will be lost during BURST transmitions',crlf));
  525.     call connect;
  526.     call set$term$attr(true);
  527.     call DQ$SPECIAL(2,@ci$conn,@status);
  528.     if check$error(1) then return;
  529.     call newline;
  530. end conn$cmd;
  531.  
  532. def$cmd: procedure PUBLIC;
  533.     call unsupported;
  534. end def$cmd;
  535.  
  536. exit$cmd: procedure(code) public;
  537.     declare code byte;
  538. /* clean up terminal attr. */
  539.     call DQ$EXIT(code);
  540. end exit$cmd;
  541.  
  542. fin$cmd: procedure PUBLIC;
  543.     if in$conn=ci$conn then do;
  544.       call print(@('can not send finish to yourself...use SET cmd first',
  545.         crlf));
  546.       return;
  547.     end;
  548.     call set$term$attr(false);
  549.     if NOT finish then
  550.       call print(@('Error ending remote KERMIT server',crlf));
  551.     call set$term$attr(true);
  552. end fin$cmd;
  553.  
  554. get$cmd: procedure PUBLIC;
  555.     if delim = cr then
  556.         call print(@('No files specified',crlf));
  557.     else do;
  558.         delim=DQ$GET$ARGUMENT(@filename,@status);
  559.         if check$error(0) then return;
  560. /* HERE IS WHERE YOU SET UP WILDCARD NAMES USING FILESTR */
  561.         call file$open(2);
  562.         if qopen then do;
  563.             call set$term$attr(false);
  564.             if get then call print(@(cr,lf,'OK',crlf));
  565.             else call print(@('get failed',crlf));
  566.             call set$term$attr(true);
  567.         end;
  568.         call file$close;
  569.     end;
  570. end get$cmd;
  571.  
  572. loc$cmd: procedure PUBLIC;
  573.     call unsupported;
  574. end loc$cmd;
  575.  
  576. log$cmd: procedure PUBLIC;
  577.     call unsupported;
  578. end log$cmd;
  579.  
  580. recv$cmd: procedure PUBLIC;
  581.         if delim <> cr then do;
  582.             delim=DQ$GET$ARGUMENT(@filename,@status);
  583.             if check$error(0) then return;
  584.             call file$open(2);
  585.         end;
  586.         call set$term$attr(false);
  587.         if recv then call print(@(cr,lf,'OK',crlf));
  588.         else call print(@(cr,lf,'error recieving file',crlf));
  589.         call set$term$attr(true);
  590.         call do$put(file$conn);
  591.         call file$close;
  592. end recv$cmd;
  593.  
  594. rem$cmd: procedure PUBLIC;
  595.     call unsupported;
  596. end rem$cmd;
  597.  
  598. send$cmd: procedure PUBLIC;
  599.     if delim = cr then
  600.         call print(@('No files specified',crlf));
  601.     else do;
  602.         delim=DQ$GET$ARGUMENT(@filename,@status);
  603.         if check$error(0) then return;
  604. /* HERE IS WHERE YOU SET UP WILDCARD NAMES USING FILESTR */
  605.         call file$open(1);
  606. /*  add check for output file spec */
  607.         if qopen then do;
  608.             call set$term$attr(false);
  609.             if send then call print(@(cr,lf,'OK',crlf));
  610.             else call print(@('Send failed',crlf));
  611.             call set$term$attr(true);
  612.           end;
  613.           call file$close;
  614.         end;
  615. end send$cmd;
  616.  
  617. serv$cmd: procedure PUBLIC;
  618.     call unsupported;
  619. end serv$cmd;
  620.  
  621. set$cmd: procedure PUBLIC;
  622.     if delim = cr then
  623.       call print(@('No parameter specified',crlf));
  624.     else do;
  625.       delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  626.       if check$error(0) then return;
  627.       call get$para;
  628.       end;
  629. end set$cmd;
  630.  
  631. get$para: procedure EXTERNAL;
  632. end get$para;
  633.  
  634. get$in$cmd: procedure EXTERNAL;
  635. end get$in$cmd;
  636.  
  637. show$cmd: procedure PUBLIC;
  638.     call unsupported;
  639. end show$cmd;
  640.  
  641. stat$cmd: procedure PUBLIC;
  642.     call unsupported;
  643. end stat$cmd;
  644.  
  645. take$cmd: procedure PUBLIC;
  646.     declare i byte;
  647.     if delim = cr then
  648.         call print(@('No file specified',crlf));
  649.     else do;
  650.         delim=DQ$GET$ARGUMENT(@takename,@status);
  651.         if check$error(0) then return;
  652.         take$conn=DQ$ATTACH(@takename,@STATUS);
  653.         if check$error(0) then return;
  654.         call DQ$OPEN(take$conn,1,2,@status);
  655.         if check$error(0) then return;
  656. /* here is where you read cmd file, line by line */
  657.         do while get$line <> 0;
  658.             i=DQ$SWITCH$BUFFER(@buffer,@status);
  659.             if check$error(1) then return;
  660.             delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  661.             if check$error(0) then return;
  662.             if cmdstr(0)>0 then call get$in$cmd;
  663.         end;
  664.         call DQ$CLOSE(take$conn,@status);
  665.         if check$error(0) then return;
  666.         call DQ$DETACH(take$conn,@status);
  667.         if check$error(0) then return;
  668.     end;
  669. end take$cmd;
  670.  
  671. tran$cmd: procedure PUBLIC;
  672.     if delim = cr then
  673.         call print(@('No files specified',crlf));
  674.     else do;
  675.         delim=DQ$GET$ARGUMENT(@filename,@status);
  676.         if check$error(0) then return;
  677. /* HERE IS WHERE YOU SET UP WILDCARD NAMES USING FILESTR */
  678.         call file$open(1);
  679.       if qopen then do;
  680.         call print(@('Please enter wait interval between 64',
  681.             ' byte bursts',crlf));
  682.         call readln;
  683.         delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  684.         if check$error(0) then return;
  685.         cmdstr(cmdstr(0))=delim;
  686.         trans_wait=nin(.cmdstr(1));
  687.         call set$term$attr(false);
  688.         if trans then call print(@(cr,lf,'OK',crlf));
  689.         else call print(@('Transmit failed',crlf));
  690.         call set$term$attr(true);
  691.       end;
  692.       call file$close;
  693.     end;
  694. end tran$cmd;
  695.  
  696. ambiguous: procedure EXTERNAL;
  697. end ambiguous;
  698.  
  699. unsupported: procedure EXTERNAL;
  700. end unsupported;
  701.  
  702. unknown: procedure(cmd$ptr) EXTERNAL;
  703.     declare cmd$ptr pointer;
  704. end unknown;
  705.  
  706. do$cmd: procedure EXTERNAL;
  707. end do$cmd;
  708.  
  709. do$para: procedure EXTERNAL;
  710. end do$para;
  711.  
  712. get$baud: procedure EXTERNAL;
  713. end get$baud;
  714.  
  715. get$duplex: procedure EXTERNAL;
  716. end get$duplex;
  717.  
  718. output$baud: procedure EXTERNAL;
  719. end output$baud;
  720.  
  721. baud$para: procedure PUBLIC;
  722.     if delim=cr then do;
  723.       baud_rate=0;
  724.     end;
  725.     else do;
  726.       delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  727.       if check$error(0) then return;
  728.       call get$baud;
  729.       if cmd<=0 then return;
  730.       if in$conn=ci$conn then do;
  731.         call print(@('about to change consol baud rate to ',null));
  732.         call output$baud;
  733.         call print(@(', please confirm:',null));
  734.         if NOT query then return;
  735.       end;
  736.     end;
  737.     if baud_rate=0 then term$attr.in$baud$rate=old_baud_in;
  738.     else term$attr.in$baud$rate=baud_rate;
  739.     call RQ$S$SPECIAL(in$conn,5,@term$attr,@buffer,@status);
  740.     if check$error(1) then return;
  741. end baud$para;
  742.  
  743. block$para: procedure PUBLIC;
  744.     call unsupported;
  745. end block$para;
  746.  
  747. debug$para: procedure PUBLIC;
  748.     debug= NOT debug;
  749.     if debug then call print(@('DEBUG ON',crlf));
  750.     else call print(@('DEBUG OFF',crlf));
  751. end debug$para;
  752.  
  753. delay$para: procedure PUBLIC;
  754.     if delim=cr then send$delay=5;
  755.     else do;
  756.       delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  757.       if check$error(0) then return;
  758.       cmdstr(cmdstr(0))=delim;
  759.       send$delay=nin(.cmdstr(1));
  760.     end;
  761. end delay$para;
  762.  
  763. dup$para: procedure PUBLIC;
  764.     if delim=cr then duplex=0;
  765.     else do;
  766.       delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  767.       if check$error(0) then return;
  768.       call get$duplex;
  769.     end;
  770. end dup$para;
  771.  
  772. esc$para: procedure PUBLIC;
  773.     call unsupported;
  774. end esc$para;
  775.  
  776. file$para: procedure PUBLIC;
  777.     call unsupported;
  778. end file$para;
  779.  
  780. flow$para: procedure PUBLIC;
  781.     call unsupported;
  782. end flow$para;
  783.  
  784. hand$para: procedure PUBLIC;
  785.     call unsupported;
  786. end hand$para;
  787.  
  788. ibm$para: procedure PUBLIC;
  789.     call unsupported;
  790. end ibm$para;
  791.  
  792. inco$para: procedure PUBLIC;
  793.     call unsupported;
  794. end inco$para;
  795.  
  796. par$para: procedure PUBLIC;
  797.     call unsupported;
  798. end par$para;
  799.  
  800. port$para: procedure PUBLIC;
  801.     if delim=cr then call return$to$ci;
  802.     else do;
  803.       delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  804.       if check$error(0) then return;
  805.       if cmdstr(0)<>4 or (CMPB(@cmdstr(1),@(':CI:'),4)<>-1
  806.           and CMPB(@cmdstr(1),@(':CO:'),4)<>-1) then do;
  807.         if in$conn <> ci$conn then call close$in;
  808.         in$conn=DQ$ATTACH(@cmdstr,@status);
  809.         if check$error(0) then return;
  810.         call DQ$OPEN(in$conn,3,0,@status);
  811.         if check$error(0) then return;
  812.         out$conn=in$conn;
  813.         call get$term$attr;
  814.         old_baud_in=term$attr.in$baud$rate;
  815.         if baud_rate <> 0 then do;
  816. /*  set new terminal to requested baud rate */
  817.         end;
  818.         call print(@('set connection via ',null));
  819.         call prints(@cmdstr);
  820.         call newline;
  821.       end;
  822.       else call return$to$ci;
  823.     end;
  824.     call get$term$attr;
  825. end port$para;
  826.  
  827. recv$para: procedure PUBLIC;
  828.     call unsupported;
  829. end recv$para;
  830.  
  831. retry$para: procedure PUBLIC;
  832.     call unsupported;
  833. end retry$para;
  834.  
  835. send$para: procedure PUBLIC;
  836.     call unsupported;
  837. end send$para;
  838.  
  839. /* *** main program *** */
  840.  
  841. outlen=0;
  842. debug = false;
  843. server$mode=false;
  844. dev_attach=false;
  845. qopen = false;
  846. send$delay=5;
  847. send$eol=cr;       recv$eol=cr;
  848. send$paclen=94;      recv$paclen=94;
  849. send$padchar=0;      recv$padchar=0;
  850. send$padding=0;      recv$padding=0;
  851. send$pause=1;      recv$pause=1;
  852. send$quote=23H;      recv$quote=23H;
  853. send$start=soh;      recv$start=soh;
  854. send$time=5;      recv$time=5;
  855. baud_rate=0;    /* use system default */
  856. block_check=1; /* simple check-sum */
  857. duplex=0;        /* 0=FULL, 1=HALF */
  858. break_char=1DH; /* default ^] */
  859. parity=4;        /* parity code 0, set to 0 on output
  860.                               ignore on input, but clear bit 7
  861.                            1, set to 1 on output
  862.                               ignore on input, but clear bit 7
  863.                            2, even parity in and out
  864.                            3, odd  parity in and out
  865.                            4, 8-bit...do not check or change bit 7 */
  866. term$attr.num$words=5;
  867. term$attr.num$used=5;
  868. call spar(.send$setup$string);
  869. call rpar(.send$setup$string);
  870.  
  871. call ioinit;
  872.  
  873. old_baud_ci=term$attr.in$baud$rate;
  874. old_baud_in=0;
  875.  
  876. call print(@('RMX-86 Kermit Version 1.0',crlf));
  877.  
  878. do while (true);
  879.     call print(@('Kermit-RMX>',null));
  880.     call readln;
  881.     delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  882.     if check$error(1) then call exit$cmd(3);
  883.     if cmdstr(0)>0 then call get$in$cmd;
  884. end;
  885.  
  886. end kermit;
  887.