Retro1.org codex

          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