home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / sinclairqlb / ql2set.bcp < prev   
Text File  |  1988-08-15  |  11KB  |  485 lines
  1. // This is file QL2SET.BCP
  2. //
  3. // To be renamed FLP2_KERSET_BCPL for QDOS
  4. SECTION "Set-options"
  5. /*       Implementation of the Kermit SET command in BCPL
  6.  
  7.          Written by David Harper
  8.  
  9. */
  10. GET "LIBHDR"
  11. GET "FLP2_KERHDR"
  12. //
  13. LET do.set() BE
  14. $(0
  15.   LET fn.set = 0
  16.   IF nwords = 1 DO
  17.   $(1 // The only word on the command line is SET
  18.     writes("No keyword supplied to SET.*N")
  19.     show.set()
  20.     RETURN
  21.   $)1
  22.   TEST do.parse(argv!1,set.com.table) THEN
  23.   $(2 // We have found a command
  24.     TEST nwords=2 THEN
  25.     $(3 // We only have the keyword ... no value
  26.       writef("SET %S : no value specified*N",argv!1)
  27.     $)3
  28.     ELSE
  29.     $(4 // Set the parameter
  30.         /* Programming note : we do this by using an array of functions
  31.            called set.function.table. For example, to set parity, we
  32.            match argv!1 with the entry ws.parity in the command word
  33.            table set.com.table ; then the function we need to use to
  34.            set the parity will be the entry ws.entry in the function
  35.            table set.function.table
  36.  
  37.            The invocation of the routine is as follows :
  38.         */
  39.            fn.set := set.function.table!command   // Get the function address
  40.            fn.set()                               // Invoke it
  41.         /*
  42.            Check the routine 'initialise' in "MAIN" for the proper names
  43.            of the set functions as they are initialised.
  44.         */
  45.            ser.corrupt := line.changed(command)   // Altered RS232
  46.                                                   // characteristics ?
  47.     $)4
  48.   $)2
  49.   ELSE
  50.   $(5
  51.     writef("Error : unknown option SET %S*N",argv!1)
  52.     erroring := TRUE
  53.   $)5
  54. $)0
  55. AND numeric.value(string) = VALOF
  56. $(0 // Convert a string to a positive numeric value
  57. /* This routine uses the following convention for representation of a
  58.    number :
  59.  
  60.    Prefix $ indicates a hexadecimal number
  61.  
  62.    Otherwise (default) it's a decimal number
  63.  
  64.    Any invalid characters within the string cause the result to be set
  65.    to -1
  66. */
  67. LET radix,ksum,ch,nch,kch,hex = 10,0,0,0,0,FALSE
  68. nch := getbyte(string,0)
  69. kch := 0
  70. IF getbyte(string,1)='$' THEN
  71. $(1 // We have a hex number
  72.   radix := 16
  73.   hex   := TRUE
  74.   kch   := kch + 1
  75. $)1
  76. $(2 // Process each character
  77.   kch := kch + 1
  78.   IF kch>nch THEN BREAK           // End of the string
  79.   ch := getbyte(string,kch)
  80.   SWITCHON ch INTO
  81.   $(3 // Branch on the character just read
  82.     CASE '0' :  ksum := radix*ksum
  83.                 ENDCASE
  84.  
  85.     CASE '1' :  ksum := radix*ksum + 1
  86.                 ENDCASE
  87.  
  88.     CASE '2' :  ksum := radix*ksum + 2
  89.                 ENDCASE
  90.  
  91.     CASE '3' :  ksum := radix*ksum + 3
  92.                 ENDCASE
  93.  
  94.     CASE '4' :  ksum := radix*ksum + 4
  95.                 ENDCASE
  96.  
  97.     CASE '5' :  ksum := radix*ksum + 5
  98.                 ENDCASE
  99.  
  100.     CASE '6' :  ksum := radix*ksum + 6
  101.                 ENDCASE
  102.  
  103.     CASE '7' :  ksum := radix*ksum + 7
  104.                 ENDCASE
  105.  
  106.     CASE '8' :  ksum := radix*ksum + 8
  107.                 ENDCASE
  108.  
  109.     CASE '9' :  ksum := radix*ksum + 9
  110.                 ENDCASE
  111.  
  112.     CASE 'A' :  TEST hex THEN ksum := radix*ksum + 10
  113.                          ELSE ksum := -1
  114.                          ENDCASE
  115.  
  116.     CASE 'B' :  TEST hex THEN ksum := radix*ksum + 11
  117.                          ELSE ksum := -1
  118.                          ENDCASE
  119.  
  120.     CASE 'C' :  TEST hex THEN ksum := radix*ksum + 12
  121.                          ELSE ksum := -1
  122.                          ENDCASE
  123.  
  124.     CASE 'D' :  TEST hex THEN ksum := radix*ksum + 13
  125.                          ELSE ksum := -1
  126.                          ENDCASE
  127.  
  128.     CASE 'E' :  TEST hex THEN ksum := radix*ksum + 14
  129.                          ELSE ksum := -1
  130.                          ENDCASE
  131.  
  132.     CASE 'F' :  TEST hex THEN ksum := radix*ksum + 15
  133.                          ELSE ksum := -1
  134.                          ENDCASE
  135.  
  136.     DEFAULT  :  ksum := -1
  137.                 ENDCASE
  138.   $)3
  139. $)2 REPEATUNTIL  ksum<0
  140. RESULTIS ksum
  141. $)0
  142. //
  143. //
  144. //
  145. AND microparse(aword,entries,word1,word2,word3,word4,word5,word6,word7,
  146.   word8,word9,word10) = VALOF $(0
  147.   LET thisword,kword,found,maxentry = @word1,0,FALSE,0
  148.   maxentry := (entries>10 ->  10,entries)
  149.   $(1
  150.     kword := kword + 1
  151.     found := strcomp(aword,!thisword)
  152.     thisword := thisword + 1
  153.   $)1 REPEATUNTIL found | (kword=maxentry)
  154.   RESULTIS (found -> kword,0)
  155. $)0
  156. //
  157. //
  158. //
  159. AND bad.set.option() BE $(0
  160.   writes("Invalid option encountered :*N")
  161.   writef("SET %S %S*N",argv!1,argv!2)
  162. $)0
  163. /*
  164.  
  165.    We now give the routines used to set the various options
  166.  
  167. */
  168. AND set.debug() BE $(0
  169.   LET option = microparse(argv!2,2,"ON","OFF")
  170.   AND dfd = 0
  171.   SWITCHON option INTO
  172.   $(1
  173.     CASE 1 : // SET DEBUG ON
  174.       debug := TRUE
  175.       IF nwords=4 THEN
  176.       $(F // we have a filename ... try to open it
  177.         dfd := findoutput(argv!3)
  178.         TEST dfd>0 THEN debug.fd := dfd
  179.                    ELSE $( debug.fd := console
  180.                            writes("*NFailed to open debug file ")
  181.                            writes(argv!3)
  182.                            newline()
  183.                         $)
  184.       $)F
  185.       ENDCASE
  186.  
  187.     CASE 2 : // SET DEBUG OFF
  188.       debug := FALSE
  189.       IF nwords=4 THEN
  190.       $(G // do we want to close the current debug file ?
  191.         IF strcomp(argv!3,"CLOSE") & debug.fd\=console THEN
  192.         $(CD  close(debug.fd)
  193.               debug.fd := console
  194.         $)CD
  195.       $)G
  196.       ENDCASE
  197.  
  198.     DEFAULT : // Unknown option
  199.       bad.set.option()
  200.   $)1
  201. $)0
  202. //
  203. AND set.delay() BE $(0
  204.   LET option = numeric.value(argv!2)
  205.   TEST option<0 THEN
  206.   $(1  bad.set.option()  $)1
  207.   ELSE
  208.   $(2
  209.     TEST option<60 THEN remote.delay := option
  210.     ELSE $(3  writef("You don't really want to wait %N seconds",option)
  211.               writes(", do you ?*N")
  212.               remote.delay := 60
  213.          $)3
  214.   $)2
  215. $)0
  216. //
  217. AND set.duplex() BE $(0
  218.   LET option = microparse(argv!2,2,"FULL","HALF")
  219.   SWITCHON option INTO
  220.   $(1
  221.     CASE 1 : // SET DUPLEX FULL
  222.       ser.duplex := 'F'
  223.       ENDCASE
  224.  
  225.     CASE 2 : // SET DUPLEX HALF
  226.       ser.duplex := 'H'
  227.       ENDCASE
  228.  
  229.     DEFAULT : // Unknown option
  230.       bad.set.option()
  231.   $)1
  232. $)0
  233. //
  234. AND set.8bitprefixing() BE $(0
  235.   LET option = microparse(argv!2,2,"ON","OFF")
  236.   SWITCHON option INTO
  237.   $(1
  238.     CASE 1 : // SET 8BIT-PREFIX ON
  239.       quote8ing := TRUE
  240.       ENDCASE
  241.  
  242.     CASE 2 : // SET 8BIT-PREFIX OFF
  243.       quote8ing := FALSE
  244.       ENDCASE
  245.  
  246.     DEFAULT : // Unknown option
  247.       bad.set.option()
  248.   $)1
  249. $)0
  250. //
  251. AND set.eol() BE $(0
  252.   LET option = microparse(argv!2,2,"CR","LF")
  253.   SWITCHON option INTO
  254.   $(1
  255.     CASE 1 : // SET END-OF-LINE CR
  256.       r.eol := cr
  257.       ENDCASE
  258.  
  259.     CASE 2 : // SET END-OF-LINE LF
  260.       r.eol := lf
  261.       ENDCASE
  262.  
  263.     DEFAULT : // Unknown option
  264.       bad.set.option()
  265.   $)1
  266. $)0
  267. //
  268. AND set.terminal.escape() BE $(0
  269.   LET option = microparse(argv!2,7,"F1","F2","F3","F4","F5","ESC","CTRL-ESC")
  270.   SWITCHON option INTO
  271.   $(1
  272.     CASE 1 : // SET ESCAPE-CHAR F1
  273.       ser.escape := kbd.f1
  274.       ENDCASE
  275.  
  276.     CASE 2 : // SET ESCAPE-CHAR F2
  277.       ser.escape := kbd.f2
  278.       ENDCASE
  279.  
  280.     CASE 3 : // SET ESCAPE-CHAR F3
  281.       ser.escape := kbd.f3
  282.       ENDCASE
  283.  
  284.     CASE 4 : // SET ESCAPE-CHAR F4
  285.       ser.escape := kbd.f4
  286.       ENDCASE
  287.  
  288.     CASE 5 : // SET ESCAPE-CHAR F5
  289.       ser.escape := kbd.f5
  290.       ENDCASE
  291.  
  292.     CASE 6 : // SET ESCAPE-CHAR ESC
  293.       ser.escape := kbd.esc
  294.       ENDCASE
  295.  
  296.     CASE 7 : // SET ESCAPE-CHAR CTRL-ESC
  297.       ser.escape := kbd.ctrl.esc
  298.       ENDCASE
  299.  
  300.     DEFAULT : // Unknown option
  301.       bad.set.option()
  302.   $)1
  303. $)0
  304. //
  305. AND set.marker() BE $(0
  306.   LET option = numeric.value(argv!2)
  307.   TEST option>=0 & option<27 THEN  r.sop := option
  308.                              ELSE  bad.set.option()
  309. $)0
  310. //
  311. AND set.packet.length() BE $(0
  312.   LET option = numeric.value(argv!2)
  313.   TEST option>10 & option<93 THEN  r.packet.length := option
  314.                              ELSE  bad.set.option()
  315. $)0
  316. //
  317. AND set.pad.char() BE $(0
  318.   LET option = numeric.value(argv!2)
  319.   TEST option>=0 & option<32 THEN  r.padchar := option
  320.                              ELSE bad.set.option()
  321. $)0
  322. //
  323. AND set.padding() BE $(0
  324.   LET option = numeric.value(argv!2)
  325.   TEST option>=0 THEN r.pad := option
  326.                  ELSE bad.set.option()
  327. $)0
  328. //
  329. AND set.parity() BE $(0
  330.   LET option = microparse(argv!2,5,"EVEN","ODD","MARK","SPACE","NONE")
  331.   SWITCHON option INTO
  332.   $(1
  333.     CASE 1 : // SET PARITY EVEN
  334.       ser.parity := 'E'
  335.       ENDCASE
  336.  
  337.     CASE 2 : // SET PARITY ODD
  338.       ser.parity := 'O'
  339.       ENDCASE
  340.  
  341.     CASE 3 : // SET PARITY MARK
  342.       ser.parity := 'M'
  343.       ENDCASE
  344.  
  345.     CASE 4 : // SET PARITY SPACE
  346.       ser.parity := 'S'
  347.       ENDCASE
  348.  
  349.     CASE 5 : // SET PARITY NONE
  350.       ser.parity := 'N'
  351.       ENDCASE
  352.  
  353.     DEFAULT : // Unknown option
  354.       bad.set.option()
  355.   $)1
  356. $)0
  357. //
  358. AND set.pause() BE $(0
  359.   LET option = numeric.value(argv!2)
  360.   TEST option>=0 THEN ser.pause := option
  361.                  ELSE bad.set.option()
  362. $)0
  363. //
  364. AND set.prefix() BE  quote8 := getbyte(argv!2,1)
  365.  
  366. //
  367. AND set.retry() BE $(0
  368.   LET option = numeric.value(argv!2)
  369.   TEST option>0 THEN maxtry := option
  370.                 ELSE bad.set.option()
  371. $)0
  372. //
  373. AND set.timeout() BE $(0
  374.   LET option = numeric.value(argv!2)
  375.   TEST option>0 THEN r.timeout := option
  376.                 ELSE bad.set.option()
  377. $)0
  378. //
  379. AND set.line() BE $(0
  380.   LET option = microparse(argv!2,4,"1","SER1","2","SER2")
  381.   SWITCHON option INTO
  382.   $(1
  383.     CASE 1 : // SET LINE 1
  384.     CASE 2 : // SET LINE SER1
  385.       ser.line := '1'
  386.       ENDCASE
  387.  
  388.     CASE 3 : // SET LINE 2
  389.     CASE 4 : // SET LINE SER2
  390.       ser.line := '2'
  391.       ENDCASE
  392.  
  393.     DEFAULT : // Unknown option
  394.       bad.set.option()
  395.   $)1
  396. $)0
  397. //
  398. AND set.baud() BE $(0
  399.   LET option = numeric.value(argv!2)
  400.   SWITCHON option INTO
  401.   $(1
  402.     CASE 75: CASE 150: CASE 300: CASE 600: CASE 1200: CASE 2400:
  403.     CASE 3600: CASE 4800: CASE 9600:
  404.       ser.baud := option
  405.       ENDCASE
  406.  
  407.     DEFAULT : // Unknown option
  408.       bad.set.option()
  409.   $)1
  410. $)0
  411. AND set.interface() BE $(0
  412.   LET option = microparse(argv!2,3,"NONE","RAW","QCONNECT")
  413.   SWITCHON option INTO
  414.   $(1
  415.     CASE 1 : CASE 2 : // SET INTERFACE NONE or RAW  i.e. no little black box
  416.       ser.interface := interface.none
  417.       ENDCASE
  418.  
  419.     CASE 3 : // SET INTERFACE QCONNECT : Tandata's little black box
  420.       ser.interface := interface.qconnect
  421.       ENDCASE
  422.  
  423.     DEFAULT : // Unknown option
  424.       bad.set.option()
  425.   $)1
  426. $)0
  427. //
  428. AND set.handshake() BE $(0
  429.   LET option = microparse(argv!2,3,"CTS","XON","NONE")
  430.   SWITCHON option INTO
  431.   $(1
  432.     CASE 1 : // Hardware handshake
  433.       ser.handshake := 'H'
  434.       ENDCASE
  435.  
  436.     CASE 2 : // Software handshake
  437.       ser.handshake := 'X'
  438.       ENDCASE
  439.  
  440.     CASE 3 : // No handshake at all
  441.       ser.handshake := 'I'
  442.       ENDCASE
  443.  
  444.     DEFAULT : // Whoops !!
  445.       bad.set.option()
  446.   $)1
  447. $)0
  448. //
  449. AND line.changed(value) = (value=ws.parity) | (value=ws.line) |
  450.   (value=ws.baud) | (value=ws.handshake) | (value=ws.interface)
  451. //
  452. AND not.yet.implemented() BE $(0
  453.   writes("*N This option has not yet been implemented. *N")
  454. $)0
  455. //
  456. AND set.take.echo() BE $(0
  457.   LET option = microparse(argv!2,2,"ON","OFF")
  458.   SWITCHON option INTO
  459.   $(1
  460.     CASE 1 : // SET TAKE-ECHO ON
  461.       take.echo := TRUE
  462.       ENDCASE
  463.  
  464.     CASE 2 : // SET TAKE-ECHO OFF
  465.       take.echo := FALSE
  466.       ENDCASE
  467.  
  468.     DEFAULT : // Unknown option
  469.       bad.set.option()
  470.   $)1
  471. $)0
  472. //
  473. AND set.packetlength() BE $(0
  474.   LET option = numeric.value(argv!2)
  475.   TEST option>30 & option <93 THEN
  476.   $(1
  477.     maxpack := option
  478.   $)1
  479.   ELSE
  480.   $(2
  481.     maxpack := 80
  482.     bad.set.option()
  483.   $)2
  484. $)0
  485.