home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
sinclairqlb.tar.gz
/
sinclairqlb.tar
/
ql2set.bcp
< prev
Wrap
Text File
|
1988-08-16
|
11KB
|
485 lines
// This is file QL2SET.BCP
//
// To be renamed FLP2_KERSET_BCPL for QDOS
SECTION "Set-options"
/* Implementation of the Kermit SET command in BCPL
Written by David Harper
*/
GET "LIBHDR"
GET "FLP2_KERHDR"
//
LET do.set() BE
$(0
LET fn.set = 0
IF nwords = 1 DO
$(1 // The only word on the command line is SET
writes("No keyword supplied to SET.*N")
show.set()
RETURN
$)1
TEST do.parse(argv!1,set.com.table) THEN
$(2 // We have found a command
TEST nwords=2 THEN
$(3 // We only have the keyword ... no value
writef("SET %S : no value specified*N",argv!1)
$)3
ELSE
$(4 // Set the parameter
/* Programming note : we do this by using an array of functions
called set.function.table. For example, to set parity, we
match argv!1 with the entry ws.parity in the command word
table set.com.table ; then the function we need to use to
set the parity will be the entry ws.entry in the function
table set.function.table
The invocation of the routine is as follows :
*/
fn.set := set.function.table!command // Get the function address
fn.set() // Invoke it
/*
Check the routine 'initialise' in "MAIN" for the proper names
of the set functions as they are initialised.
*/
ser.corrupt := line.changed(command) // Altered RS232
// characteristics ?
$)4
$)2
ELSE
$(5
writef("Error : unknown option SET %S*N",argv!1)
erroring := TRUE
$)5
$)0
AND numeric.value(string) = VALOF
$(0 // Convert a string to a positive numeric value
/* This routine uses the following convention for representation of a
number :
Prefix $ indicates a hexadecimal number
Otherwise (default) it's a decimal number
Any invalid characters within the string cause the result to be set
to -1
*/
LET radix,ksum,ch,nch,kch,hex = 10,0,0,0,0,FALSE
nch := getbyte(string,0)
kch := 0
IF getbyte(string,1)='$' THEN
$(1 // We have a hex number
radix := 16
hex := TRUE
kch := kch + 1
$)1
$(2 // Process each character
kch := kch + 1
IF kch>nch THEN BREAK // End of the string
ch := getbyte(string,kch)
SWITCHON ch INTO
$(3 // Branch on the character just read
CASE '0' : ksum := radix*ksum
ENDCASE
CASE '1' : ksum := radix*ksum + 1
ENDCASE
CASE '2' : ksum := radix*ksum + 2
ENDCASE
CASE '3' : ksum := radix*ksum + 3
ENDCASE
CASE '4' : ksum := radix*ksum + 4
ENDCASE
CASE '5' : ksum := radix*ksum + 5
ENDCASE
CASE '6' : ksum := radix*ksum + 6
ENDCASE
CASE '7' : ksum := radix*ksum + 7
ENDCASE
CASE '8' : ksum := radix*ksum + 8
ENDCASE
CASE '9' : ksum := radix*ksum + 9
ENDCASE
CASE 'A' : TEST hex THEN ksum := radix*ksum + 10
ELSE ksum := -1
ENDCASE
CASE 'B' : TEST hex THEN ksum := radix*ksum + 11
ELSE ksum := -1
ENDCASE
CASE 'C' : TEST hex THEN ksum := radix*ksum + 12
ELSE ksum := -1
ENDCASE
CASE 'D' : TEST hex THEN ksum := radix*ksum + 13
ELSE ksum := -1
ENDCASE
CASE 'E' : TEST hex THEN ksum := radix*ksum + 14
ELSE ksum := -1
ENDCASE
CASE 'F' : TEST hex THEN ksum := radix*ksum + 15
ELSE ksum := -1
ENDCASE
DEFAULT : ksum := -1
ENDCASE
$)3
$)2 REPEATUNTIL ksum<0
RESULTIS ksum
$)0
//
//
//
AND microparse(aword,entries,word1,word2,word3,word4,word5,word6,word7,
word8,word9,word10) = VALOF $(0
LET thisword,kword,found,maxentry = @word1,0,FALSE,0
maxentry := (entries>10 -> 10,entries)
$(1
kword := kword + 1
found := strcomp(aword,!thisword)
thisword := thisword + 1
$)1 REPEATUNTIL found | (kword=maxentry)
RESULTIS (found -> kword,0)
$)0
//
//
//
AND bad.set.option() BE $(0
writes("Invalid option encountered :*N")
writef("SET %S %S*N",argv!1,argv!2)
$)0
/*
We now give the routines used to set the various options
*/
AND set.debug() BE $(0
LET option = microparse(argv!2,2,"ON","OFF")
AND dfd = 0
SWITCHON option INTO
$(1
CASE 1 : // SET DEBUG ON
debug := TRUE
IF nwords=4 THEN
$(F // we have a filename ... try to open it
dfd := findoutput(argv!3)
TEST dfd>0 THEN debug.fd := dfd
ELSE $( debug.fd := console
writes("*NFailed to open debug file ")
writes(argv!3)
newline()
$)
$)F
ENDCASE
CASE 2 : // SET DEBUG OFF
debug := FALSE
IF nwords=4 THEN
$(G // do we want to close the current debug file ?
IF strcomp(argv!3,"CLOSE") & debug.fd\=console THEN
$(CD close(debug.fd)
debug.fd := console
$)CD
$)G
ENDCASE
DEFAULT : // Unknown option
bad.set.option()
$)1
$)0
//
AND set.delay() BE $(0
LET option = numeric.value(argv!2)
TEST option<0 THEN
$(1 bad.set.option() $)1
ELSE
$(2
TEST option<60 THEN remote.delay := option
ELSE $(3 writef("You don't really want to wait %N seconds",option)
writes(", do you ?*N")
remote.delay := 60
$)3
$)2
$)0
//
AND set.duplex() BE $(0
LET option = microparse(argv!2,2,"FULL","HALF")
SWITCHON option INTO
$(1
CASE 1 : // SET DUPLEX FULL
ser.duplex := 'F'
ENDCASE
CASE 2 : // SET DUPLEX HALF
ser.duplex := 'H'
ENDCASE
DEFAULT : // Unknown option
bad.set.option()
$)1
$)0
//
AND set.8bitprefixing() BE $(0
LET option = microparse(argv!2,2,"ON","OFF")
SWITCHON option INTO
$(1
CASE 1 : // SET 8BIT-PREFIX ON
quote8ing := TRUE
ENDCASE
CASE 2 : // SET 8BIT-PREFIX OFF
quote8ing := FALSE
ENDCASE
DEFAULT : // Unknown option
bad.set.option()
$)1
$)0
//
AND set.eol() BE $(0
LET option = microparse(argv!2,2,"CR","LF")
SWITCHON option INTO
$(1
CASE 1 : // SET END-OF-LINE CR
r.eol := cr
ENDCASE
CASE 2 : // SET END-OF-LINE LF
r.eol := lf
ENDCASE
DEFAULT : // Unknown option
bad.set.option()
$)1
$)0
//
AND set.terminal.escape() BE $(0
LET option = microparse(argv!2,7,"F1","F2","F3","F4","F5","ESC","CTRL-ESC")
SWITCHON option INTO
$(1
CASE 1 : // SET ESCAPE-CHAR F1
ser.escape := kbd.f1
ENDCASE
CASE 2 : // SET ESCAPE-CHAR F2
ser.escape := kbd.f2
ENDCASE
CASE 3 : // SET ESCAPE-CHAR F3
ser.escape := kbd.f3
ENDCASE
CASE 4 : // SET ESCAPE-CHAR F4
ser.escape := kbd.f4
ENDCASE
CASE 5 : // SET ESCAPE-CHAR F5
ser.escape := kbd.f5
ENDCASE
CASE 6 : // SET ESCAPE-CHAR ESC
ser.escape := kbd.esc
ENDCASE
CASE 7 : // SET ESCAPE-CHAR CTRL-ESC
ser.escape := kbd.ctrl.esc
ENDCASE
DEFAULT : // Unknown option
bad.set.option()
$)1
$)0
//
AND set.marker() BE $(0
LET option = numeric.value(argv!2)
TEST option>=0 & option<27 THEN r.sop := option
ELSE bad.set.option()
$)0
//
AND set.packet.length() BE $(0
LET option = numeric.value(argv!2)
TEST option>10 & option<93 THEN r.packet.length := option
ELSE bad.set.option()
$)0
//
AND set.pad.char() BE $(0
LET option = numeric.value(argv!2)
TEST option>=0 & option<32 THEN r.padchar := option
ELSE bad.set.option()
$)0
//
AND set.padding() BE $(0
LET option = numeric.value(argv!2)
TEST option>=0 THEN r.pad := option
ELSE bad.set.option()
$)0
//
AND set.parity() BE $(0
LET option = microparse(argv!2,5,"EVEN","ODD","MARK","SPACE","NONE")
SWITCHON option INTO
$(1
CASE 1 : // SET PARITY EVEN
ser.parity := 'E'
ENDCASE
CASE 2 : // SET PARITY ODD
ser.parity := 'O'
ENDCASE
CASE 3 : // SET PARITY MARK
ser.parity := 'M'
ENDCASE
CASE 4 : // SET PARITY SPACE
ser.parity := 'S'
ENDCASE
CASE 5 : // SET PARITY NONE
ser.parity := 'N'
ENDCASE
DEFAULT : // Unknown option
bad.set.option()
$)1
$)0
//
AND set.pause() BE $(0
LET option = numeric.value(argv!2)
TEST option>=0 THEN ser.pause := option
ELSE bad.set.option()
$)0
//
AND set.prefix() BE quote8 := getbyte(argv!2,1)
//
AND set.retry() BE $(0
LET option = numeric.value(argv!2)
TEST option>0 THEN maxtry := option
ELSE bad.set.option()
$)0
//
AND set.timeout() BE $(0
LET option = numeric.value(argv!2)
TEST option>0 THEN r.timeout := option
ELSE bad.set.option()
$)0
//
AND set.line() BE $(0
LET option = microparse(argv!2,4,"1","SER1","2","SER2")
SWITCHON option INTO
$(1
CASE 1 : // SET LINE 1
CASE 2 : // SET LINE SER1
ser.line := '1'
ENDCASE
CASE 3 : // SET LINE 2
CASE 4 : // SET LINE SER2
ser.line := '2'
ENDCASE
DEFAULT : // Unknown option
bad.set.option()
$)1
$)0
//
AND set.baud() BE $(0
LET option = numeric.value(argv!2)
SWITCHON option INTO
$(1
CASE 75: CASE 150: CASE 300: CASE 600: CASE 1200: CASE 2400:
CASE 3600: CASE 4800: CASE 9600:
ser.baud := option
ENDCASE
DEFAULT : // Unknown option
bad.set.option()
$)1
$)0
AND set.interface() BE $(0
LET option = microparse(argv!2,3,"NONE","RAW","QCONNECT")
SWITCHON option INTO
$(1
CASE 1 : CASE 2 : // SET INTERFACE NONE or RAW i.e. no little black box
ser.interface := interface.none
ENDCASE
CASE 3 : // SET INTERFACE QCONNECT : Tandata's little black box
ser.interface := interface.qconnect
ENDCASE
DEFAULT : // Unknown option
bad.set.option()
$)1
$)0
//
AND set.handshake() BE $(0
LET option = microparse(argv!2,3,"CTS","XON","NONE")
SWITCHON option INTO
$(1
CASE 1 : // Hardware handshake
ser.handshake := 'H'
ENDCASE
CASE 2 : // Software handshake
ser.handshake := 'X'
ENDCASE
CASE 3 : // No handshake at all
ser.handshake := 'I'
ENDCASE
DEFAULT : // Whoops !!
bad.set.option()
$)1
$)0
//
AND line.changed(value) = (value=ws.parity) | (value=ws.line) |
(value=ws.baud) | (value=ws.handshake) | (value=ws.interface)
//
AND not.yet.implemented() BE $(0
writes("*N This option has not yet been implemented. *N")
$)0
//
AND set.take.echo() BE $(0
LET option = microparse(argv!2,2,"ON","OFF")
SWITCHON option INTO
$(1
CASE 1 : // SET TAKE-ECHO ON
take.echo := TRUE
ENDCASE
CASE 2 : // SET TAKE-ECHO OFF
take.echo := FALSE
ENDCASE
DEFAULT : // Unknown option
bad.set.option()
$)1
$)0
//
AND set.packetlength() BE $(0
LET option = numeric.value(argv!2)
TEST option>30 & option <93 THEN
$(1
maxpack := option
$)1
ELSE
$(2
maxpack := 80
bad.set.option()
$)2
$)0