IDENT SETCHT
ENTRY SETCHT
SYSCOM B1
TITLE SETCHT - SET INPUT CHARACTER TYPE.
*COMMENT SETCHT - SET INPUT CHARACTER TYPE.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SETCHT SPACE 4,10
***** SETCHT - SET CHARACTER TYPE.
*
* W.E. MARTIN. 77/05/05.
SPACE 4,10
* COMMOM TEXT DEFINITION.
*CALL COMCMAC
*CALL COMKMAC
*CALL COMSPRD
SPACE 4,30
*** SETCHT - SET CHARACTER TYPE.
*
* SET CHARACTER TYPE ALLOWS A TASK TO CHANGE THE CHARACTER
* TYPE ASSOCIATED WITH A PARTICULAR TERMINAL. THE ARGUMENTS
* ARE CHECKED FOR VALIDITY AND A *CTI* CALL IS MADE IN ORDER
* TO PASS THE REQUEST ON TO THE NETWORK SUPERVISOR.
*
* CALL FORMAT -
* FORTRAN EXTENDED - CALL SETCHT(TERMINAL,STATUS,ACT)
*
* COBOL - ENTER SETCHT USING TERMINAL, STATUS, ACT.
*
* TERMINAL = TERMINAL WHICH IS TO HAVE ITS ATTRIBUTES
* CHANGED. TERMINAL IS 1 - 7 CHARACTERS,
* ZERO OR BLANK FILLED. IF A BINARY ZERO
* IS SUPPLIED, THE OPERATION APPLIES TO
* ORIGINATING TERMINAL.
*
* STATUS = LOCATION WHICH IS TO HAVE THE TERMINAL
* LOGGIN STATUS RETURNED.
*
* ACT = INTEGER VALUE FOR FORTRAN AND COMP-1 FOR
* COBOL, VALUE RANGING FROM 2 - 4, OR THE
* CHARACTER STRINGS - *ASCII7*, *ASCII5* AND
* *DISPLAY*.
VFD 42/0LSETCHT,18/SETCHT
SETCHT SUBR ENTRY/EXIT
SX6 A0 SAVE (A0)
MX0 42
SA6 SCTA
SB1 1
* PROCESS TERMINAL NAME.
SA3 X1
UX2,B3 X3
ZR X1,SCT8 IF NO ARGUMENTS - ABORT TASK
NZ B3,SCT1 IF NOT COBOL COMPUTATIONAL-1 ARGUMENT
BX1 X1-X1
ZR X2,SCT2 IF ZERO TERMINAL NAME
SCT1 BX1 X0*X3
ZR X1,SCT2 IF ZERO TERMINAL NAME
RJ ZFN ZERO FILL NAME
SCT2 BX5 X1
* PROCESS STATUS PARAMETER.
SA1 A1+B1 READ NEXT ARGUMENT
ZR X1,SCT8 IF NO *STATUS* ARGUMENT - ABORT TASK
SX7 X1 SET STATUS RETURN ADDRESS
* PROCESS ACT PARAMETER.
SA2 A1+B1
SA7 SCTB+1
ZR X2,SCT5 IF NO *ACT* ARGUMENT
SA1 X2
BX7 X0*X1
UX3,B3 X1 UNPACK POSSIBLE COBOL ARGUMENT
ZR B3,SCT3 IF NOT COBOL COMPUTATIONAL-1
NZ X7,SCT6 IF CHARACTER ARGUMENT
SCT3 SX4 X3-5
PL X4,SCT8 IF ARGUMENT TOO LARGE
SX4 X3-2
NG X4,SCT8 IF TASK *ACT* SETS MODE TO BINARY
SCT4 BX6 X5+X3 SET TERMINAL NAME AND CHARACTER TYPE
SA6 SCTB
SETCHT A6
SCT5 SA1 SCTA RESTORE (A0)
SA0 X1+
EQ SETCHTX RETURN
* PERFORM TABLE LOOKUP FOR DISPLAY ARGUMENTS.
SCT6 RJ ZFN ZERO FILL NAME
SB3 TSCTL (B3) = TABLE SIZE
SCT7 SA3 TSCT-1+B3
BX4 X0*X3
SB3 B3-B1
BX7 X4-X1
SX3 X3
ZR X7,SCT4 IF ARGUMENT FOUND
GE B3,SCT7 IF TABLE NOT EXHAUSTED
* ABORT TASK FOR ARGUMENT ERROR.
SCT8 SA1 SETCHT READ TRACE-BACK WORD
MX0 30
LX1 30
SA2 X1-1 READ *RJ* FROM CALLING PROGRAM
BX6 -X0*X2
SA6 SCTB
ARGERR A6 EXIT TO EXECUTIVE
SCTA BSS 1 TEMPORARY STORAGE (A0)
SCTB BSS 2 LOCATION FOR MESSAGE HEADER
* TABLE OF TERMINAL CHARACTER TYPES.
*T 42/ CHARACTER TYPE, 18/ NETWORK REQUIRED VALUE
TSCT BSS 0 TABLE OF CHARACTER TYPES
VFD 42/0LASCII7,18/2
VFD 42/0LASCII5,18/3
VFD 42/0LDISPLAY,18/4
TSCTL EQU *-TSCT LENGTH OF CHARACTER TYPE TABLE
* COMMON DECK.
*CALL COMKZFN
END