home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
modcomp.zip
/
sset.
< prev
next >
Wrap
Text File
|
1987-01-26
|
16KB
|
594 lines
SUBROUTINE SSET (ALIN)
C
C ****************************************************************
C
C KERMIT for the MODCOMP MAXIV operating system
C
C Compliments of:
C
C SETPOINT, Inc.
C 10245 Brecksville Rd.
C Brecksville, Ohio 44141
C
C
C KERMIT is a copyrighted protocol of Columbia Univ. The authors
C of this version hereby grant permission to copy this software
C provided that it is not used for an explicitly commercial
C purpose and that proper credit be given. SETPOINT, Inc. makes
C no warranty whatsoever regarding the accuracy of this package
C and will assume no liability resulting from it's use.
C
C ****************************************************************
C
C Abstract: PARSE AND SET VARIOUS SELECTABLE PARAMETERS
C
C MODIFICATION HISTORY
C
C BY DATE REASON PROGRAMS AFFECTED
C
C ****************************************************************
C
C Author: Bob Borgeson Version: A.0 Date: Aug-86
C
C Calling Parameters:
C
C R ALIN - SET COMMAND STRING
C
C ****************************************************************
C
C Messages generated by this module :
C
C SEE THE FORMAT STATEMENTS GROUPED AT THE END OF THE CODE
C
C ****************************************************************
C
C Subroutines called directly : SKIPBL, CTOI
C
C ****************************************************************
C
C Files referenced : None
C
C ****************************************************************
C
C Local variable definitions :
C
C BLIN SCRATCH FOR CHECKING COMMANDS
C CHRFND # OF CHARACTERS FOUND
C CMDLEN MAXIMUM LENGTH OF SET COMMANDS
C CMDTBL TABLE OF UNPACKED ASCII COMMANDS
C FOUND # OF COMMANDS FOUND
C Fx CHARACTER POSITIONS TO START SEARCH AT
C GOODSP IF = 1 THE SELECTED BAUD RATE IS OK
C KUSL UNPACKED USL NAME
C NUMCMD # OF COMMANDS SEARCHED FOR
C NUMPAR # OF PARITY KEYWORDS SEARCHED FOR
C PARLEN MAXIMUM LENGTH OF PARITY KEYWORD
C TV STARTING CHARACTER OF COMMAND
C WCHCMD WHICH COMMAND WAS FOUND
C WCHPAR WHICH PARITY WAS CHOSEN
C Zx CHARACTER POSITION TO START SEARCH AT
C
C ****************************************************************
C
C Commons referenced : KER and KERPAR local commons
C
C ****************************************************************
C
C (*$END.DOCUMENT*)
C
C ****************************************************************
C * *
C * D I M E N S I O N S T A T E M E N T S *
C * *
C ****************************************************************
C
IMPLICIT INTEGER (A-Z)
C
INTEGER*2 ALIN(1) , BLIN(132) , KUSL(3), CMDTBL(8,9)
> , PARTBL(6,5)
C
C ****************************************************************
C * *
C * T Y P E S T A T E M E N T S *
C * *
C ****************************************************************
C
C
C ****************************************************************
C * *
C * C O M M O N S T A T E M E N T S *
C * *
C ****************************************************************
C
INCLUDE USL/KERCOM
INCLUDE USL/KERPMC
C
C ****************************************************************
C * *
C * E Q U I V A L E N C E S T A T E M E N T S *
C * *
C ****************************************************************
C
C
C ****************************************************************
C * *
C * D A T A S T A T E M E N T S *
C * *
C ****************************************************************
C
DATA CMDTBL /66,65,85,68,10002,0,0,0,
> 68,69,76,65,89,10002,0,0,
> 80,65,82,73,84,89,10002,0,
> 69,83,67,65,80,69,10002,0,
> 80,65,67,75,69,84,10002,0,
> 83,79,72,10002,0,0,0,0,
> 69,79,76,10002,0,0,0,0,
> 77,89,81,85,79,84,69,10002,
> 85,83,76,10002,0,0,0,0/
C
DATA PARTBL /79,68,68,10002,0,0,
> 69,86,69,78,10002,0,
> 77,65,82,75,10002,0,
> 83,80,65,67,69,10002,
> 78,79,78,69,10002,0/
C
DATA NUMPAR / 5 /
> ,NUMCMD / 9 /
> ,PARLEN / 6 /
> ,CMDLEN / 8 /
C
C ****************************************************************
C
C Code starts here :
C
C-----> Skip past SET to start of first parameter.
C
A1 = 1
CALL SKIPBL (ALIN,A1)
TV = A1
C
C-----> Find the SET function - first strip this word
C
FOUND = -1
IEND = 81 - TV
C
DO 10 I = 1,IEND
C
BLIN(I) = ALIN(TV+I-1)
C
IF((BLIN(I) .EQ. LF) .OR. (BLIN(I) .EQ. BLANK))GO TO 20
C
10 CONTINUE
C
20 CONTINUE
C
BLIN(I) = LF
BLIN(I+1) = EOS
C
TV = I + 2
C
DO 50 J = 1,NUMCMD
C
DO 30 I = 1,CMDLEN
C
C-----> If you get LF, then we got a legal command
C
IF(BLIN(I) .EQ. LF)GO TO 40
C
C-----> If end of command, then no match
C
IF(CMDTBL(I,J) .EQ. EOS)GO TO 50
C
C-----> Check for matching character
C
IF(BLIN(I) .NE. CMDTBL(I,J))GO TO 50
C
30 CONTINUE
C
GO TO 50
C
40 CONTINUE
C
C------> Found your keyword
C
WCHCMD = J
FOUND = FOUND + 1
C
50 CONTINUE
C
IF (FOUND) 70 , 90 , 80
C
70 CONTINUE
C
C-----> No command was recognized
C
WRITE(LOCALO,75)
75 FORMAT(' UNRECOGNIZED COMMAND - TYPE "HELP"')
RETURN
C
80 CONTINUE
C
C-----> The command was not unique
C
WRITE(LOCALO,85)
85 FORMAT(' AMBIGUOUS COMMAND - TYPE "HELP"')
RETURN
C
90 CONTINUE
C
C-----> Service the requested command
C
GO TO(100,200,300,500,800,900,1000,1100,1200) , WCHCMD
C
100 CONTINUE
C
C-----> Set BAUD rate.
C
C
C-----> If baud rate setting not supported, or in HOST mode,
C-----> do not allow baud rate to be set.
C
C+++++++
HOSTON = NO
SBAUD = YES
C+++++++++
IF (SBAUD .NE. YES) GO TO 190
IF (HOSTON .NE. YES) GO TO 120
WRITE (LOCALO,9100)
WRITE (LOCALO,9101)
RETURN
120 CONTINUE
C
C-----> Get the desired baud rate from the command line and
C-----> convert it to an integer.
C
F1 = TV
CALL SKIPBL (ALIN,F1)
X = CTOI (ALIN,F1)
C
C-----> Validate the speed against the allowable values.
C
IF (X .EQ. 300 .OR.
> X .EQ. 1200 .OR.
> X .EQ. 2400 .OR.
> X .EQ. 4800 .OR.
> X .EQ. 9600 .OR.
> X .EQ. 19200 ) GO TO 130
WRITE (LOCALO,9102)
RETURN
130 CONTINUE
SPEED = X
RETURN
190 CONTINUE
WRITE (LOCALO,9103)
RETURN
C
200 CONTINUE
C
C-----> Set the initial packet delay period if not
C-----> in remote host mode.
C
IF (HOSTON .NE. NO) GO TO 210
WRITE (LOCALO,9104)
RETURN
210 CONTINUE
C
C-----> Get the delay value.
C
F2 = TV
CALL SKIPBL (ALIN,F2)
X = CTOI (ALIN,F2)
IF (X .GT. 0) GO TO 220
WRITE (LOCALO,9105)
RETURN
220 CONTINUE
C
C-----> Only allow values in range of 0..60.
C
IF (X .LE. 60) GO TO 230
DELAY = 60
WRITE (LOCALO,9106)
WRITE (LOCALO,9107)
RETURN
230 CONTINUE
DELAY = X
RETURN
300 CONTINUE
C
C-----> Set data parity.
C
C+++++++++
HOSTON = NO
SPARITY = YES
C+++++++++++++
IF (SPARITY .NE. YES) GO TO 390
IF (HOSTON .NE. YES) GO TO 310
WRITE (LOCALO,9108)
WRITE (LOCALO,9109)
RETURN
310 CONTINUE
C
F3 = TV
CALL SKIPBL(ALIN,F3)
TV = F3
C
C-----> Pull out the parity keyword
C
DO 315 I = 1,6
C
BLIN(I) = ALIN(TV+I-1)
IF((BLIN(I) .EQ. LF) .OR. (BLIN(I) .EQ. BLANK))GO TO 320
C
315 CONTINUE
C
320 CONTINUE
C
BLIN(I) = LF
BLIN(I+1) = EOS
C
FOUND = -1
C
DO 345 J = 1,NUMPAR
C
DO 325 I = 1,PARLEN
C
C------> If end of keyword, then this is a good answer
C
IF(BLIN(I) .EQ. LF)GO TO 335
C
C------> If end of search pattern, no good
C
IF(PARTBL(I,J) .EQ. EOS)GO TO 345
C
C------> Check next character
C
IF(BLIN(I) .NE. PARTBL(I,J))GO TO 345
C
325 CONTINUE
C
GO TO 345
C
335 CONTINUE
C
C------> Remember which keyword was found
C
WCHPAR = J
FOUND = FOUND + 1
C
345 CONTINUE
C
IF (FOUND) 385 , 350 , 80
C
350 CONTINUE
C
GO TO (360 , 360 , 380 , 370 , 360 ), WCHPAR
C
360 CONTINUE
C
C-----> Set the selected parity flag
C
PARITY = WCHPAR
RETURN
C
370 CONTINUE
C
C-----> This parity is not supported on MODCOMP
C
WRITE(LOCALO,9110)
RETURN
C
380 CONTINUE
C
C-----> This parity is not supported on MODCOMP
C
WRITE(LOCALO,9111)
RETURN
C
385 CONTINUE
C
WRITE(LOCALO,9112)
RETURN
C
390 CONTINUE
C
C-----> Parity not selectable.
C
WRITE (LOCALO,9113)
RETURN
500 CONTINUE
C
C-----> Set HOST mode escape character.
C
IF (HOSTON .NE. YES) GO TO 510
WRITE (LOCALO,9117)
WRITE (LOCALO,9118)
RETURN
510 CONTINUE
F5 = TV
CALL SKIPBL (ALIN,F5)
X = CTOI (ALIN,F5)
IF (X .LE. 0 .OR.
> X .GE. 32 ) GO TO 520
ESCHAR = X
RETURN
520 CONTINUE
WRITE (LOCALO,9119)
RETURN
800 CONTINUE
C
C-----> Set the packet size.
C
F8 = TV
CALL SKIPBL(ALIN,F8)
X = CTOI(ALIN,F8)
IF (X .LE. 30 .OR.
> X .GE. 95 ) GO TO 810
PAKSIZ = X
RETURN
810 CONTINUE
WRITE (LOCALO,9126)
RETURN
900 CONTINUE
C
C-----> Set the start of header character.
C
F9 = TV
CALL SKIPBL (ALIN,F9)
X = CTOI (ALIN,F9)
IF (HOSTON .NE. YES) GO TO 930
IF (X .NE. EOL) GO TO 910
WRITE (LOCALO,9127)
RETURN
910 CONTINUE
IF (X .LE. 0 .OR.
> X .GE. 32 ) GO TO 920
SOH = X
RETURN
920 CONTINUE
WRITE (LOCALO,9128)
RETURN
930 CONTINUE
IF (X .NE. EOL .AND.
> X .NE. PROMPT ) GO TO 940
WRITE (LOCALO,9129)
WRITE (LOCALO,9130)
RETURN
940 CONTINUE
IF (X .LE. 0 .OR.
> X .GE. 32 ) GO TO 950
SOH = X
RETURN
950 CONTINUE
WRITE (LOCALO,9131)
WRITE (LOCALO,9132)
RETURN
1000 CONTINUE
C
C-----> Set the end-of-line character.
C
F10 = TV
CALL SKIPBL (ALIN,F10)
X = CTOI (ALIN,F10)
IF (HOSTON .NE. YES) GO TO 1030
IF (X .NE. SOH) GO TO 1010
WRITE (LOCALO,9133)
RETURN
1010 CONTINUE
IF (X .LE. 0 .OR.
> X .GE. 32 ) GO TO 1020
MYEOL = X
RETURN
1020 CONTINUE
WRITE (LOCALO,9134)
WRITE (LOCALO,9135)
RETURN
1030 CONTINUE
IF (X .NE. SOH .AND.
> X .NE. PROMPT ) GO TO 1040
WRITE (LOCALO,9136)
WRITE (LOCALO,9137)
RETURN
1040 CONTINUE
IF (X .LE. 0 .OR.
> X .GE. 32 )GO TO 1050
MYEOL = X
RETURN
1050 CONTINUE
WRITE (LOCALO,9138)
WRITE (LOCALO,9139)
RETURN
1100 CONTINUE
C
C-----> Set the quoting character.
C
F11 = TV
CALL SKIPBL (ALIN,F11)
X = CTOI (ALIN,F11)
IF (X .LE. 32 .OR.
> X .GE. 127 ) GO TO 1110
MYQUOTE = X
RETURN
1110 CONTINUE
WRITE (LOCALO,9140)
WRITE (LOCALO,9141)
RETURN
1200 CONTINUE
C
C-----> Set the USL directory for files to send.
C
F12 = TV
CALL SKIPBL (ALIN,F12)
C
C-----> Make the USL name is CAN codeable.
C
CHRFND = 0
C
DO 1210 I=1,3
ICHAR = ALIN(F12+3-I)
C
IF((ICHAR .EQ. LF) .OR. (ICHAR .EQ. EOS))ALIN(F12+3-I) = BLANK
IF(((ICHAR .EQ. BLANK) .OR. (ICHAR .EQ. LF) .OR.
> (ICHAR .EQ. EOS)) .AND. (CHRFND .EQ. 0))GO TO 1210
CHRFND = CHRFND + 1
C
IF ((ICHAR .GE. BIGA .AND. ICHAR .LE. BIGZ) .OR.
> (ICHAR .GE. DIG0 .AND. ICHAR .LE. DIG9) .OR.
> (ICHAR .EQ. COLON) .OR.
> (ICHAR .EQ. PERIOD) .OR.
> (ICHAR .EQ. DOLLAR) ) GO TO 1210
GO TO 1220
1210 CONTINUE
C
IF(CHRFND .EQ. 0)GO TO 1220
GO TO 1230
C
1220 CONTINUE
C
C-----> USL not can codeable.
C
WRITE (LOCALO,9143)
RETURN
1230 CONTINUE
KUSL(1) = ISHFT (ALIN(F12),8)
KUSL(2) = ISHFT (ALIN(F12+1),8)
KUSL(3) = ISHFT (ALIN(F12+2),8)
SUSL = IACAN4 (KUSL)
RETURN
9100 FORMAT(' BAUD RATE SETTING NOT SUPPORTED')
9101 FORMAT(' IN REMOTE HOST MODE')
9102 FORMAT(' INVALID OR UNSUPPORTED BAUD RATE SELECTED')
9103 FORMAT(' THIS SYSTEM DOES NOT SUPPORT BAUD SELECTION')
9104 FORMAT(' DELAY SETTING NOT VALID IN LOCAL HOST MODE')
9105 FORMAT(' INVALID DELAY SETTING')
9106 FORMAT(' DELAY SETTING TOO LONG')
9107 FORMAT(' DEFAULTED TO 60 SECONDS')
9108 FORMAT(' PARITY SETTING NOT SUPPORTED')
9109 FORMAT(' IN REMOTE HOST MODE')
9110 FORMAT(' SPACE PARITY NOT SUPPORTED IN MAXIV')
9111 FORMAT(' MARK PARITY NOT SUPPORTED IN MAXIV')
9112 FORMAT(' PARITY SELECTED NOT VALID')
9113 FORMAT(' PARITY SETTING NOT SUPPORTED IN THIS SYSTEM')
9117 FORMAT(' ESCAPE SETTING NOT VALID IN')
9118 FORMAT(' REMOTE HOST MODE')
9119 FORMAT(' ESCAPE CHARACTER MUST BE BETWEEN 0 & 32')
9126 FORMAT(' INVALID PACKET SIZE SPECIFIED')
9127 FORMAT(' INVALID; IN CONFLICT WITH EOL')
9128 FORMAT(' INVALID; SOH MUST BE BETWEEN 0 & 32')
9129 FORMAT(' INVALID; IN CONFLICT WITH EOL')
9130 FORMAT(' OR IBM PROMPT')
9131 FORMAT(' INVALID; SOH MUST BE BETWEEN')
9132 FORMAT(' 0 & 32')
9133 FORMAT(' INVALID; IN CONFLICT WITH SOH')
9134 FORMAT(' INVALID; EOL MUST BE BETWEEN')
9135 FORMAT(' 0 & 32')
9136 FORMAT(' INVALID; EOL IN CONFLICT WITH')
9137 FORMAT(' SOH OR IBM PROMPT')
9138 FORMAT(' INVALID; EOL MUST BE BETWEEN')
9139 FORMAT(' 0 & 32')
9140 FORMAT(' QUOTE CHARACTER MUST BE BETWEEN')
9141 FORMAT(' 32 & 127')
9142 FORMAT(' INVALID SET PARAMETER(S) DETECTED')
9143 FORMAT(' USL NAME NOT CANCODEABLE')
9144 FORMAT(' INVALID SET HOST MODE SELECTED')
END