SETCHT
          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 
