TERMDEF 
          IDENT  TERMDEF
          ENTRY  TERMDEF
          SYSCOM B1 
          TITLE  TERMDEF - SET TERMINAL DEFINITIONS.
*COMMENT  TERMDEF - TERMINAL DEFINITION ROUTINE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
*****     TERMDEF - TERMINAL DEFINITION.
*         W.E. MARTIN.       78/01/20.
*         M. S. PESCHMAN.     86/03/06. 
*         T. E. SCHULL.       86/05/20. 
          SPACE  4,60 
***       TERMDEF - TERMINAL DEFINITION FOR NETWORKS. 
* 
*         TERMINAL DEFINITION FOR NETWORKS ALLOWS THE USER TO DEFINE
*         THE ATTRIBUTES OF A TERMINAL IN THE SAME FASHION THAT A USER
*         MIGHT DO AT THE TERMINAL.  THIS ALLOWS TASKS TO CHANGE
*         ATTRIBUTES OF TERMINALS WITHOUT DIRECT USER INTERACTION.
*         THE KEYWORDS ARE FOUND FROM A TABLE AND DEPENDING ON THE
*         APPROPRIATE CONTEXT, THE VALUE OF THE ARGUMENT IS COMPUTED. 
*         THE (KEYWORD,VALUE) LIST IS MAPPED INTO THE FORMAT REQUIRED 
*         FOR THE SUPERVISORY MESSAGE AND A *CTI* TERMDEF IS ISSUED FOR 
*         A SUBSEQUENT TRANSMISSION OF THE MESSAGE TO THE NETWORK.
* 
*         CALL FORMAT - 
* 
*         FORTRAN EXTENDED -
* 
*         CALL TERMDEF(TERMINAL,STATUS,MSG1,MSG2,...,MSGN)
* 
*         COBOL - 
* 
*         ENTER TERMDEF USING TERMINAL STATUS MSG1 MSG2 ... MSGN. 
* 
*               WHERE - TERMINAL = NAME OF TERMINAL TO BE OPERATED
*                                  UPON. IF THE VALUE OF TERMINAL IS
*                                  EQUAL TO ZERO, THEN THE ORIGINATING
*                                  TERMINAL IS USED.
* 
*               STATUS = LOCATION TO RETURN LOGIN STATUS.  THIS VALUE 
*                        IS RETURNED TO THE TASK AS AN UNNORMALIZED 
*                        FLOATING POINT NUMBER. 
* 
*               MSGN = A DATA NAME CONTAINING LEFT JUSTIFIED BINARY 
*                      ZERO OR BLANK FILLED TERMINAL ATTRIBUTE TO 
*                      CHANGE.
*                      IN FORTRAN, MSGN MAY BE OF FORM 5LPW=40, 
*                      5LPL=60, OR 5LCN=2A ...ETC.
* 
* 
*         FOR TERMINALS NOT LOGGED IN, THE VALUE OF THE STATUS WORD 
*         WILL BE RETURNED NON-ZERO, AND HENCE THE CONSTANT ZERO
*         SHOULD NOT BE USED AS AN ARGUMENT.  TASKS ATTEMPTING
*         TO SET THE ATTRIBUTES OF A TERMINAL NOT ASSIGNED TO THE 
*         SAME DATA BASE WILL BE ABORTED.  TERMDEF DOES NOT HAVE ENOUGH 
*         INFORMATION TO DETECT ALL ERRORS, SO ERRORS MAY BE RETURNED 
*         TO *ITASK* FOR RESOLUTION, SINCE THE TASK IS NOT PLACED ON
*         RECALL UNTIL THE RESPONSE IS RETURNED FROM THE NETWORK. 
*         NOTE - A *CTI* CALL IS ISSUED FOR EACH (KEYWORD,VALUE) PAIR,
*         RATHER THAN ONE FOR THE ENTIRE PROGRAM LEVEL CALL.
          SPACE  4
*         COMMON DECK.
  
  
*CALL     COMCMAC 
*CALL     COMKMAC 
*CALL     COMSNCD 
*CALL     COMSPRD 
  
          TITLE  MAIN ROUTINE.
  
          VFD    42/0LTERMDEF,18/TERMDEF
 TDF6     SA1    TDFC        RESTORE (A0) 
          SA0    X1+
  
 TERMDEF  SUBR               ENTRY/EXIT 
          SX6    A0          SAVE (A0)
          SB1    1
          SA2    A1 
          ZR     X1,TDF5     IF NO ARGUMENTS - ABORT TASK 
          SA6    TDFC 
  
*         PROCESS TERMINAL NAME AND STATUS PARAMETER. 
  
          SA4    X2          SET TERMINAL NAME INTO BUFFER
          UX1,B2 X4          UNPACK POSSIBLE COBOL ARGUMENT 
          ZR     X1,TDF1     IF NO TERMINAL NAME
          MX0    42 
          BX1    X0*X4
          RJ     ZFN         ZERO FILL NAME 
 TDF1     BX6    X1          SET DESTINATION TERMINAL 
          SA2    A2+B1
          SA6    MCBA 
          SA1    X2 
          ZR     X2,TDF5     IF SHORT ARGUMENT LIST 
          BX6    X2 
          SA2    A2+B1
          SA6    A6+B1       STORE STATUS ADDRESS 
          SA1    X2 
          SX6    A2-B1       PRESET (A2)
          ZR     X2,TDF5     IF SHORT ARGUMENT LIST 
          SA6    TDFE 
  
*         BUILD SUPERVISORY MESSAGE.
  
 TDF2     SX7    2           RESET BUFFER POINTERS
          SA3    TDFE        RESTORE PARAMETER LIST POINTER 
          SX6    44 
          SA7    MCBB 
          SA6    MCBC 
          SA1    MCBD 
          BX6    X1 
          SX7    B1+B1       RESET DEFAULT COUNT OF 8-BIT VALUES
          SA6    MCBA+2 
          SA7    MCBE 
          SA7    TDFA 
  
*         PROCESS KEYWORD ARGUMENT. 
  
          MX0    12 
          SA2    X3+B1
          SA1    X2          READ KEYWORD ARGUMENT
          BX1    X0*X1
          ZR     X2,TDF6     IF END OF ARGUMENT LIST
          RJ     FKA         FIND KEYWORD ARGUMENT
          NG     X6,TDF5     IF INCORRECT KEYWORD 
          SX7    A2+
          SA7    TDFE 
          ZR     X1,TDF3     IF KEYWORD IS *EB* OR *EL* 
          SB7    1           NUMBER OF 8-BIT VALUES TO TRANSFER 
          RJ     MCB         MERGE FIELD NUMBER FROM *TTDC* INTO BUFFER 
          SA3    TDFE        RESTORE (A2) 
          SA2    X3+
 TDF3     SA1    X2+         READ ARGUMENT
          MX0    -6 
          LX1    18 
          SX4    1R=
          BX2    -X0*X1 
          BX3    X2-X4
          NZ     X3,TDF5     IF THIRD CHARACTER IS NOT *=*
          SA3    FKAA 
          SB3    X3+
          JP     B3          PROCESSING ROUTINE 
  
*         REQUEST SUPERVISORY MESSAGE TO BE SENT TO THE NETWORK.
  
 TDF4     SA1    MCBA        SET COUNT OF 8-BIT VALUES INTO BUFFER
          SA2    MCBE 
          BX6    X2+X1
          SA6    A1 
          TERMDEF MCBA
          MX0    42          RESET COUNT OF 8-BIT VALUES
          SA1    MCBA 
          BX6    X0*X1
          SA6    MCBA 
          EQ     TDF2        PROCESS NEXT MESSAGE 
  
*         ABORT TASK FOR ARGUMENT ERROR.
  
 TDF5     SA1    TERMDEF     SET TRACE-BACK WORD IN BUFFER
          MX0    30 
          LX1    30 
          SA2    X1-1        READ *RJ* FROM CALLING PROGRAM 
          BX6    -X0*X2 
          SA6    MCBA 
          ARGERR A6          EXIT TO EXECUTIVE
  
  
 TDFA     CON    0           SCRATCH STORAGE FOR ARGUMENT PROCESSORS
 TDFB     CON    0           SCRATCH STORAGE FOR ARGUMENT PROCESSORS
 TDFC     CON    0           STORAGE LOCATION FOR (A0)
 TDFD     CON    0           SCRATCH STORAGE FOR ARGUMENT PROCESSORS
 TDFE     CON    0           SCRATCH STORAGE FOR ARGUMENT PROCESSORS
          TITLE  SUBROUTINES. 
 PDA      SPACE  4,20 
 PDH      SPACE  4,20 
**        CHB - CONVERT HEXADECIMAL TO BINARY.
* 
*         THIS ROUTINE CONVERTS TWO DISPLAY CODED HEXADECIMAL 
*         CHARACTERS TO THEIR BINARY EQUIVALENT.
* 
*         ENTRY  (X1) = TWO DISPLAY CODED HEXADECIMAL CHARACTERS, 
*                       LEFT JUSTIFIED. 
* 
*         EXIT   (X1) = 8-BIT FIELD VALUE, RIGHT JUSTIFIED. 
* 
*         USES   X - 0, 1, 3, 4, 6. 
*                B - 3. 
* 
  
  
 CHB3     IX1    X6+X1
  
 CHB      SUBR               ENTRY/EXIT 
          MX0    12 
          BX1    X0*X1
          MX4    -6 
          BX0    X1 
          SX6    16 
          SB3    2           MAXIMUM NUMBER OF DIGITS TO PROCESS
 CHB1     LX0    5-59 
          SB3    B3-1 
          BX1    -X4*X0      EXTRACT CHARACTER
          SX3    X1-1R+ 
          PL     X3,TDF5     IF CHARACTER > 9 
          SX3    X1-1R0      CONVERT NUMERIC CHARACTER TO HEX DIGIT 
          PL     X3,CHB2     IF NUMERIC CHARACTER 
          SX3    X1-1RG 
          PL     X3,TDF5     IF CHARACTER BETWEEN G AND Z 
          SX3    X1-1RA 
          NG     X3,TDF5     IF CHARACTER < A 
          SX3    X1+9        CONVERT ALPHA CHARACTER TO HEX DIGIT 
 CHB2     BX1    X3 
          ZR     B3,CHB3     IF BOTH CHARACTERS PROCESSED 
          IX6    X6*X1
          EQ     CHB1        PROCESS SECOND CHARACTER 
 PDB      SPACE  4,20 
**        PDB - PROCESS DECIMAL TO BINARY.
* 
*         THIS ROUTINE CONVERTS THE DISPLAY CODED DECIMAL VALUE OF
*         PARAMETER *CI*, *LI*, *PL*, *PW*, OR *TC* INTO A FIELD
*         VALUE AND MERGES IT INTO THE TRANSMISSION BUFFER. 
* 
*         ENTRY  (X1) = DISPLAY CODED DECIMAL CHARACTERS, LEFT
*                       JUSTIFIED.
*                LAST 8-BIT VALUE MERGED INTO TRANSMISSION BUFFER = 
*                FIELD NUMBER FROM *CI*, *LI*, *PL*, *PW*, OR *TC*
*                ENTRY IN TABLE *TTDC*. 
* 
*         EXIT   TO *TDF4*. 
*                TO *TDF5*, IF ERROR. 
* 
*         USES   X - 0, 1, 5. 
*                B - 7. 
* 
*         CALLS  DXB, MCB, ZFN. 
  
  
 PDB      BSS    0           ENTRY
          MX0    42 
          BX1    X0*X1
          RJ     ZFN         BINARY ZERO FILL DISPLAY CODED CHARACTERS
          BX5    X1 
          SB7    B1 
          RJ     DXB         CONVERT DECIMAL VALUE TO BINARY EQUIVALENT 
          NZ     X4,TDF5     IF ERROR 
          BX1    X6 
          LX1    59-7 
          RJ     MCB         MERGE FIELD VALUE INTO BUFFER
          EQ     TDF4        RETURN 
 PDL      SPACE  4,20 
**        PDL - PROCESS PARAMETER *DL* OR *XL*. 
* 
*         THIS ROUTINE CONVERTS THE DISPLAY CODED VALUE(S) OF *DL* OR 
*         *XL* INTO FIELD NUMBERS/FIELD VALUES AND MERGES THEM INTO THE 
*         TRANSMISSION BUFFER.
* 
*         ENTRY  (A1) = FWA OF *DL* OR *XL* MESSAGE.
*                (X3) = *DL* OR *XL* ENTRY FROM TABLE *TTDC*. 
*                LAST 8-BIT VALUE MERGED INTO TRANSMISSION BUFFER = 
*                FIELD NUMBER FROM *DL* OR *XL* ENTRY IN TABLE *TTDC*.
* 
*         EXIT   TO *TDF4*. 
*                TO *TDF5*, IF ERROR. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3, 7. 
* 
*         CALLS  CHB, DXB, MCB, POP, USB, ZTB.
  
  
 PDL      BSS    0           ENTRY
          SB7    1
          AX3    18 
          SX1    X3          FIELD VALUE FOR *DL* OR *XL* 
          BX6    X1 
          SA6    PDLH        INDICATE *DL* OR *XL*
          LX1    59-7 
          RJ     MCB         MERGE FIELD VALUE INTO BUFFER
          SA1    A1+
          RJ     ZTB         BLANK FILL FIRST WORD OF MESSAGE 
          SA6    PDLC 
          MX0    -6 
          BX1    -X0*X6 
          SX2    1R 
          BX3    X1-X2
          SX2    1R.
          NZ     X3,PDL1     IF LAST CHARACTER IS NOT A BLANK 
          BX1    X0*X6
          BX6    X1+X2       INSERT TERMINATOR AT END OF FIRST WORD 
          SA6    PDLC 
          EQ     PDL2        PROCESS MESSAGE
  
 PDL1     SA1    A1+1 
          RJ     ZTB         BLANK FILL SECOND WORD OF MESSAGE
          BX1    X0*X6
          BX6    X1+X2       INSERT TERMINATOR AT END OF SECOND WORD
          SA6    PDLC+1 
 PDL2     SB2    PDLC        FIRST WORD 
          SB3    B0+
          RJ     USB         UNPACK MESSAGE INTO 1 CHARACTER PER WORD 
          RJ     POP         SKIP *DL=* OR *XL=*
 PDL3     RJ     POP         GET NEXT PARAMETER 
          NG     B5,TDF5     IF ERROR 
          BX7    X1 
          MX0    6
          SA7    PDLA        SAVE SEPARATOR 
          SA2    =1LX 
          BX1    X0*X6
          BX7    X2-X1
          SA5    PDLD 
          SA2    PDLL 
          ZR     X7,PDL4     IF FIRST CHARACTER = *X* 
          SA4    =1LY 
          BX3    X4-X1
          NZ     X3,PDL7     IF FIRST CHARACTER NOT EQUAL TO *Y*
          SA4    PDLH 
          ZR     X4,TDF5     IF *DL* MESSAGE WITH *Y* PARAMETER 
          ZR     X5,PDL6     IF NO *X* BEFORE *Y*, THEN IGNORE *Y*
          SA5    PDLG 
          SA2    PDLN 
 PDL4     NZ     X5,TDF5     IF MORE THAN ONE *X* OR *Y* IN MESSAGE 
          LX6    59-53
          BX1    X6 
          RJ     CHB         CONVERT HEXADECIMAL TO BINARY
          LX1    35-7 
          ZR     X7,PDL5     IF *X* 
          LX1    51-35
 PDL5     BX1    X1+X2
          SB7    X2          FIELD SIZE 
          RJ     MCB         MERGE *X* OR *Y* FIELD NUMBERS/VALUES
          SX6    1
          SA6    A5+         SPECIFY THAT *X* OR *Y* HAS BEEN PROCESSED 
 PDL6     SA1    PDLB 
          SX6    X1+3        ADD NUMBER OF CHARACTERS IN *X* OR *Y* 
          SA6    A1+
          EQ     PDL11       PROCESS NEXT PARAMETER 
  
 PDL7     SA2    =1LC 
          BX3    X2-X1
          NZ     X3,PDL10    IF FIRST CHARACTER NOT EQUAL TO *C*
          SA2    PDLE 
          NZ     X2,TDF5     IF MORE THAN ONE *C* IN MESSAGE
          MX0    24 
          LX0    -6 
          BX5    X0*X6       EXTRACT DECIMAL COUNT
          ZR     X5,TDF5     IF NO CHARACTER COUNT DELIMITER
          SB7    B1          INCLUDE *C* IN NUMBER OF CHARACTERS
          BX4    X5 
          LX4    59-53
          MX1    6
          MX0    54 
 PDL8     LX4    5-59        NEXT CHARACTER 
          SX3    X4-1R0 
          NG     X3,PDL9     IF NOT A DECIMAL DIGIT 
          SX3    X4-1R+ 
          PL     X3,PDL9     IF NOT A DECIMAL DIGIT 
          SB7    B7+1 
          AX1    6           SET UP MASK FOR CHARACTER COUNT DELIMITER
          BX4    X0*X4       CLEAR DIGIT JUST CHECKED 
          NZ     X4,PDL8     IF MORE CHARACTERS TO CHECK
 PDL9     SA2    PDLB 
          SX6    X2+B7       ADD NUMBER OF CHARACTERS IN *C* PARAMETER
          SA6    A2 
          BX5    X1*X5       EXTRACT DECIMAL COUNT
          LX5    59-53
          BX5    X0*X5
          SA6    PDLE        INDICATE THAT *C* HAS BEEN PROCESSED 
          RJ     DXB         CONVERT DECIMAL COUNT TO BINARY
          NZ     X4,TDF5     IF ERROR 
          MX0    -8 
          BX1    -X0*X6      EXTRACT LOWER BYTE OF COUNT
          LX1    51-7 
          LX6    7-15 
          BX2    -X0*X6      EXTRACT UPPER BYTE OF COUNT
          LX2    35-7 
          SB7    4
          SA3    PDLM        EXTRACT FIELD NUMBERS FOR *C* PARAMETER
          BX1    X1+X2
          BX1    X1+X3
          RJ     MCB         MERGE (FN=72,FV=LOWER,FN=71,FV=UPPER)
          EQ     PDL11       PROCESS NEXT PARAMETER 
  
 PDL10    SA2    =2LTO
          MX0    12 
          BX1    X0*X6
          BX3    X2-X1
          NZ     X3,TDF5     IF FIRST CHARACTERS NOT EQUAL TO *TO*
          SB7    B1+B1
          SA5    PDLF 
          NZ     X5,TDF5     IF MORE THAN ONE *TO* IN MESSAGE 
          SA1    PDLK 
          RJ     MCB         MERGE (FN=74,FV=1) 
          SA2    PDLB 
          SX6    X2+2        ADD NUMBER OF CHARACTERS IN *TO* PARAMETER 
          SA6    A2+
          SA6    A5+         INDICATE THAT *TO* HAS BEEN PROCESSED
 PDL11    SA1    PDLB 
          SX1    X1-6 
          NZ     X1,PDL12    IF PARAMETER DOES NOT END ON WORD BOUNDARY 
          SA1    PDLC+1      SECOND WORD
          MX0    6
          BX1    X0*X1
          SA2    =1L, 
          BX1    X1-X2
          NZ     X1,PDL13    IF MESSAGE LENGTH = 1 WORD 
 PDL12    SA1    PDLA        GET SEPARATOR
          SX2    1R.
          BX1    X1-X2
          NZ     X1,PDL3     IF MORE PARAMETERS TO PROCESS
 PDL13    SA2    PDLD 
          NZ     X2,PDL14    IF *X* WAS FOUND IN MESSAGE
          SA2    PDLG 
          NZ     X2,PDL14    IF *Y* WAS FOUND IN MESSAGE
          SB7    2
          SA1    PDLI 
          RJ     MCB         MERGE (FN=70,FV=0) INTO BUFFER 
 PDL14    SA2    PDLF 
          NZ     X2,PDL15    IF *TO* WAS FOUND IN MESSAGE 
          SB7    2
          SA1    PDLJ 
          RJ     MCB         MERGE (FN=74,FV=0) INTO BUFFER 
 PDL15    SX7    B0+         CLEAR FLAGS
          SA7    PDLB 
          SA7    PDLD 
          SA7    PDLE 
          SA7    PDLF 
          SA7    PDLG 
          SA7    PDLH 
          EQ     TDF4        RETURN 
  
  
 PDLA     CON    0           SEPARATOR
 PDLB     CON    0           LENGTH OF PARAMETERS IN CHARACTERS 
 PDLC     BSSZ   2           TEMPORARY BUFFER FOR THE MESSAGE 
 PDLD     CON    0           FLAG TO INDICATE THAT *X* WAS PROCESSED
 PDLE     CON    0           FLAG TO INDICATE THAT *C* WAS PROCESSED
 PDLF     CON    0           FLAG TO INDICATE THAT *TO* WAS PROCESSED 
 PDLG     CON    0           FLAG TO INDICATE THAT *Y* WAS PROCESSED
 PDLH     CON    0           FLAG TO INDICATE *DL* OR *XL*
 PDLI     VFD    8/70B,8/0   FIELD NUMBER AND VALUE IF NO *X* AND *Y* 
 PDLJ     VFD    8/74B,8/0   FIELD NUMBER AND FIELD VALUE IF NO *TO*
 PDLK     VFD    8/74B,8/1   FIELD NUMBER AND FIELD VALUE IF *TO* 
  
*         8/  FIELD NUMBER, 8/  FIELD VALUE, 8/  FIELD NUMBER, 8/  0, 
*         10/  , 18/  FIELD SIZE. 
  
 PDLL     VFD    8/70B,8/1,8/73B,8/0,10/,18/4  *X*
  
*         8/  FIELD NUMBER, 8/  0, 8/  FIELD NUMBER, 8/  0. 
  
 PDLM     VFD    8/72B,8/0,8/71B,8/0  *C* 
  
*         8/  FIELD NUMBER, 8/  0, 26/  , 18/  FIELD SIZE.
  
 PDLN     VFD    8/105B,8/0,26/,18/2  *Y* 
 PEB      SPACE  4,20 
**        PEB - PROCESS PARAMETER *EB* OR *EL*. 
* 
*         THIS ROUTINE CONVERTS THE DISPLAY CODED VALUE(S) OF *EB* OR 
*         *EL* INTO FIELD NUMBERS/FIELD VALUES AND MERGES THEM INTO THE 
*         TRANSMISSION BUFFER.
* 
*         ENTRY  (A1) = FWA OF *EB* OR *EL* MESSAGE.
*                (X1) = DISPLAY CODED VALUE(S) OF *EB* OR *EL* MESSAGE, 
*                       LEFT JUSTIFIED. 
*                (X3) = *EB* OR *EL* ENTRY FROM TABLE *TTDC*. 
* 
*         EXIT   TO *TDF4*. 
*                TO *TDF5*, IF ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 1, 2, 6. 
*                B - 5, 6, 7. 
* 
*         CALLS  CHB, MCB.
  
  
 PEB      BSS    0           ENTRY
          AX3    18 
          SB5    X3          FWA OF *EB* OR *EL* TABLE
          SB6    B5+PEBAL    LWA OF *EB* OR *EL* TABLE
          SX5    B1+B1       MAXIMUM NUMBER OF PARAMETERS TO PROCESS
          BX6    X1          SAVE (X1)
          SA6    PEBD 
 PEB1     MX0    12 
          BX3    X0*X1       GET PARAMETER VALUE
          LX3    11-59
 PEB2     SA1    B5 
          BX2    X0*X1       PARAMETER VALUE FROM TABLE 
          LX2    11-59
          IX4    X3-X2
          ZR     X4,PEB3     IF MATCH FOUND 
          SB5    B5+1 
          PL     X4,PEB2     IF MORE ENTRIES TO CHECK 
          SA1    PEBD 
          RJ     CHB         CONVERT HEX DIGITS TO BINARY 
          LX1    39-7 
          SA2    B6+
          BX1    X1+X2       MERGE FIELD VALUE WITH TABLE ENTRY 
 PEB3     SX6    X1          GET TABLE FLAG 
          SA2    PEBC        GET CURRENT FLAG 
          BX2    X6-X2
          ZR     X2,TDF5     IF PARAMETER HAS ALREADY BEEN PROCESSED
          SA6    A2+         INDICATE THAT PARAMETER HAS BEEN PROCESSED 
          SX5    X5-1        NUMBER OF PARAMETERS LEFT TO PROCESS 
          LX1    59-47       FIELD NUMBER AND FIELD VALUE 
          SB7    B1+B1
          RJ     MCB         MERGE INTO BUFFER
          ZR     X5,PEB4     IF MAXIMUM NUMBER OF PARAMETERS PROCESSED
          SA2    =1R,        CHECK FOR SEPARATOR
          SA1    PEBD 
          LX1    5-47 
          MX0    -6 
          BX3    -X0*X1 
          BX4    X2-X3
          NZ     X4,PEB4     IF NO MORE PARAMETERS
          BX6    X1 
          SA6    A1 
          SB5    B6-PEBAL    *PEBA* OR *PEBB* 
          EQ     PEB1        PROCESS SECOND PARAMETER 
  
 PEB4     SX6    B0+         CLEAR FLAG 
          SA6    PEBC 
          EQ     TDF4        RETURN 
  
  
*         TABLE OF *EB* FIELD NUMBERS AND FIELD VALUES. 
  
*         12/  PARAMETER VALUE, 8/  FIELD NUMBER, 8/  FIELD VALUE,
*         14/  , 18/  FLAG INDICATING FIRST OR SECOND PARAMETER.
  
 PEBA     VFD    12/2LCL,8/102B,8/3,14/,18/2
          VFD    12/2LCR,8/102B,8/1,14/,18/2
          VFD    12/2LEB,8/101B,8/2,14/,18/1
          VFD    12/2LEL,8/101B,8/1,14/,18/1
          VFD    12/2LLF,8/102B,8/2,14/,18/2
          VFD    12/2LNO,8/102B,8/0,14/,18/2
          CON    -0          TERMINATION WORD 
  
*         TABLE ENTRY FOR *EB* = 2 HEXADECIMAL DIGITS.
  
*         12/  , 8/  FIELD NUMBER, 8/  0, 14/  ,
*         18/  FLAG INDICATING FIRST OR SECOND PARAMETER. 
  
          VFD    12/,8/100B,8/0,14/,18/1
 PEBAL    EQU    *-PEBA-1    NUMBER OF *EB* TABLE ENTRIES 
  
*         TABLE OF *EL* FIELD NUMBERS AND FIELD VALUES. 
  
*         12/  PARAMETER VALUE, 8/  FIELD NUMBER, 8/  FIELD VALUE,
*         14/  , 18/  FLAG INDICATING FIRST OR SECOND PARAMETER.
  
 PEBB     VFD    12/2LCL,8/77B,8/3,14/,18/2 
          VFD    12/2LCR,8/77B,8/1,14/,18/2 
          VFD    12/2LEB,8/76B,8/2,14/,18/1 
          VFD    12/2LEL,8/76B,8/1,14/,18/1 
          VFD    12/2LLF,8/77B,8/2,14/,18/2 
          VFD    12/2LNO,8/77B,8/0,14/,18/2 
          CON    -0 
  
*         TABLE ENTRY FOR *EL* = 2 HEXADECIMAL DIGITS.
  
*         12/  , 8/  FIELD NUMBER, 8/  0, 14/  ,
*         18/  FLAG INDICATING FIRST OR SECOND PARAMETER. 
  
          VFD    12/,8/75B,8/0,14/,18/1 
 PEBBL    EQU    *-PEBB-1    NUMBER OF *EL* TABLE ENTRIES 
          ERRNZ  PEBAL-PEBBL *EB* AND *EL* TABLE LENGTHS NOT EQUAL
  
 PEBC     CON    0           FLAG INDICATING FIRST OR SECOND PARAMETER
 PEBD     CON    0           TEMPORARY STORAGE FOR (X1) 
 PHB      SPACE  4,20 
**        PHB - PROCESS HEXADECIMAL TO BINARY.
* 
*         THIS ROUTINE CONVERTS THE DISPLAY CODED HEXADECIMAL VALUE 
*         OF PARAMETER *B1*, *B2*, *BS*, *CN*, OR *CT* INTO A FIELD 
*         VALUE AND MERGES IT INTO THE TRANSMISSION BUFFER. 
* 
*         ENTRY  (X1) = TWO DISPLAY CODED HEXADECIMAL CHARACTERS, 
*                       LEFT JUSTIFIED. 
*                LAST 8-BIT VALUE MERGED INTO TRANSMISSION BUFFER = 
*                FIELD NUMBER FROM *B1*, *B2*, *BS*, *CN*, OR *CT*
*                ENTRY IN TABLE *TTDC*. 
* 
*         EXIT   TO *TDF4*. 
* 
*         USES   X - 1. 
*                B - 7. 
* 
*         CALLS  CHB, MCB.
  
  
 PHB      BSS    0           ENTRY
          RJ     CHB         CONVERT HEX CHARACTERS TO BINARY 
          SB7    B1 
          LX1    59-7 
          RJ     MCB         MERGE FIELD VALUE INTO BUFFER
          EQ     TDF4        RETURN 
 PIN      SPACE  4,20 
**        PIN - PROCESS PARAMETER *IN*. 
* 
*         THIS ROUTINE CONVERTS THE DISPLAY CODED VALUE OF *IN* INTO
*         ITS CORRESPONDING FIELD NUMBERS/FIELD VALUES AND MERGES 
*         THEM INTO THE TRANSMISSION BUFFER.
* 
*         ENTRY  (X1) = DISPLAY CODED VALUE OF *IN*, LEFT JUSTIFIED.
*                LAST 8-BIT VALUE MERGED INTO TRANSMISSION BUFFER = 
*                FIELD NUMBER FROM *IN* ENTRY IN TABLE *TTDC*.
* 
*         EXIT   TO *TDF4*. 
*                TO *TDF5*, IF ERROR. 
* 
*         USES   X - 0, 1, 3, 4.
*                A - 1. 
*                B - 2, 7.
* 
*         CALLS  MCB. 
  
  
 PIN      BSS    0           ENTRY
          MX0    12 
          BX3    X0*X1
          SB2    PINA 
          LX3    11-59
 PIN1     SA1    B2 
          BX4    X0*X1
          LX4    11-59
          IX4    X3-X4
          ZR     X4,PIN2     IF *BK*, *KB*, *PT*, *XK*, OR *XP* 
          SB2    B2+1 
          PL     X4,PIN1     IF MORE ENTRIES TO CHECK 
          MX0    6
          LX3    59-11
          BX3    X0*X3
          SA1    PINB 
          BX4    X0*X1
          BX4    X3-X4
          NZ     X4,TDF5     IF NOT *X* 
 PIN2     SB7    X1          FIELD SIZE 
          LX1    59-47       FIELD NUMBERS/FIELD VALUES 
          RJ     MCB         MERGE INTO BUFFER
          EQ     TDF4        RETURN 
  
  
*         12/  FIELD NAME, 8/  FIELD VALUE, 8/  FIELD NUMBER, 
*         8/  FIELD VALUE, 6/, 18/  FIELD SIZE. 
  
 PINA     VFD    12/2LBK,8/0,8/65B,8/2,6/,18/3  *BK*
          VFD    12/2LKB,8/0,8/65B,8/0,6/,18/3  *KB*
          VFD    12/2LPT,8/0,8/65B,8/1,6/,18/3  *PT*
          VFD    12/2LXK,8/1,8/65B,8/0,6/,18/3  *XK*
          VFD    12/2LXP,8/1,8/65B,8/1,6/,18/3  *XP*
          CON    -0          TERMINATION WORD 
  
*         6/  FIELD NAME, 6/,  8/  FIELD VALUE, 22/, 18/  FIELD SIZE. 
  
 PINB     VFD    6/1LX,6/,8/1,22/,18/1  *X* 
 PPO      SPACE  4,20 
**        PPO - PROCESS PARAMETER *OP*. 
* 
*         THIS ROUTINE CONVERTS THE DISPLAY CODED VALUE OF *OP* INTO
*         ITS CORRESPONDING FIELD VALUE AND MERGES IT INTO THE
*         TRANSMISSION BUFFER.
* 
*         ENTRY  (X1) = DISPLAY CODED VALUE OF *OP*, LEFT JUSTIFIED.
*                LAST 8-BIT VALUE MERGED INTO TRANSMISSION BUFFER = 
*                FIELD NUMBER FROM *OP* ENTRY IN TABLE *TTDC*.
* 
*         EXIT   TO *TDF4*. 
*                TO *TDF5*, IF ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 4. 
*                A - 2. 
*                B - 7. 
* 
*         CALLS  MCB. 
  
  
 PPO      BSS    0           ENTRY
          SA2    =2LPT
          SB7    B1 
          MX0    12 
          BX3    X0*X1
          BX4    X3-X2
          SX1    B1+B1
          LX1    59-7        SET FIELD VALUE TO 2 
          ZR     X4,PPO1     IF CHARACTERS = *PT* 
          SA2    =2LPR
          BX4    X3-X2
          SX1    1
          LX1    59-7        SET FIELD VALUE TO 1 
          ZR     X4,PPO1     IF CHARACTERS = *PR* 
          SA2    =2LDI
          BX1    X3-X2       SET FIELD VALUE TO 0 
          NZ     X1,TDF5     IF CHARACTERS NOT EQUAL TO *DI*
 PPO1     RJ     MCB         MERGE FIELD VALUE INTO BUFFER
          EQ     TDF4        RETURN 
 PPA      SPACE  4,20 
**        PPA - PROCESS PARAMETER *PA*. 
* 
*         THIS ROUTINE CONVERTS THE DISPLAY CODED VALUE OF *PA* INTO
*         ITS CORRESPONDING FIELD VALUE AND MERGES IT INTO THE
*         TRANSMISSION BUFFER.
* 
*         ENTRY  (X1) = DISPLAY CODED VALUE OF *PA*, LEFT JUSTIFIED.
*                LAST 8-BIT VALUE MERGED INTO TRANSMISSION BUFFER = 
*                FIELD NUMBER FROM *PA* ENTRY IN TABLE *TTDC*.
* 
*         EXIT   TO *TDF4*. 
*                TO *TDF5*, IF ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 4. 
*                A - 2. 
*                B - 7. 
* 
*         CALLS  MCB. 
  
  
 PPA      BSS    0           ENTRY
          SA2    =1LN 
          MX0    6
          BX3    X0*X1
          BX4    X3-X2
          SX1    3
          LX1    59-7        SET FIELD VALUE TO 3 
          SB7    1
          ZR     X4,PPA1     IF CHARACTER = *N* 
          SA2    =1LE 
          BX4    X3-X2
          SX1    B1+B1
          LX1    59-7        SET FIELD VALUE TO 2 
          ZR     X4,PPA1     IF CHARACTER = *E* 
          SX1    B1 
          SA2    =1LO 
          BX4    X3-X2
          LX1    59-7        SET FIELD VALUE TO 1 
          ZR     X4,PPA1     IF CHARACTER = *O* 
          SA2    =1LZ 
          BX1    X3-X2       SET FIELD VALUE TO 0 
          NZ     X1,TDF5     IF CHARACTER NOT EQUAL TO *Z*
 PPA1     RJ     MCB         MERGE FIELD VALUE INTO BUFFER
          EQ     TDF4        RETURN 
 PYN      SPACE  4,20 
**        PYN - PROCESS PARAMETER *BR*, *EP*, *FA*, *IC*, *OC*, *PG*, 
*               OR *SE*.
* 
*         THIS ROUTINE CONVERTS THE DISPLAY CODED VALUE OF *BR*, *EP*,
*         *FA*, *IC*, *OC*, *PG* OR *SE* INTO A FIELD VALUE AND MERGES
*         IT INTO THE TRANSMISSION BUFFER.
* 
*         ENTRY  (X1) = DISPLAY CODED VALUE OF *BR*, *EP*, *FA*, *IC*,
*                       *OP*, *PG*, OR *SE*, LEFT JUSTIFIED.
*                LAST 8-BIT VALUE MERGED INTO TRANSMISSION BUFFER = 
*                FIELD NUMBER FROM *BR*, *EP*, *FA*, *IC*, *OP*, *PG*,
*                OR *SE* ENTRY IN TABLE *TTDC*. 
* 
*         EXIT   TO *TDF4*. 
*                TO *TDF5*, IF ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 4. 
*                A - 2. 
*                B - 7. 
* 
*         CALLS  MCB. 
  
  
 PYN      BSS    0           ENTRY
          SA2    =1LY 
          SB7    B1 
          MX0    6
          BX3    X0*X1
          BX4    X3-X2
          SX1    B1 
          LX1    59-7        SET FIELD VALUE TO 1 
          ZR     X4,PYN1     IF CHARACTER = *Y* 
          SA2    =1LN 
          BX1    X3-X2       SET FIELD VALUE TO 0 
          NZ     X1,TDF5     IF CHARACTER NOT EQUAL TO *N*
 PYN1     RJ     MCB         MERGE FIELD VALUE INTO BUFFER
          EQ     TDF4        RETURN 
 FKA      SPACE  4,15 
**        FKA - FIND KEYWORD ARGUMENT.
* 
*         THIS ROUTINE FINDS A KEYWORD PARAMETER FROM TABLE *TTDC* AND
*         RETURNS THE FIELD NUMBER FOR THE KEYWORD AND ITS PROCESSING 
*         ROUTINE.
* 
*         ENTRY  (X0) = MASK FOR KEYWORD IN TABLE *TTDC*. 
*                (X1) = KEYWORD TO BE FOUND, LEFT JUSTIFIED.
* 
*         EXIT   (FKAA) = *TTDC* TABLE ENTRY IF FOUND.
*                (X1) = FIELD NUMBER, LEFT JUSTIFIED. 
*                     = 0, IF KEYWORD IS *EB* OR *EL*.
*                (X6) = NEGATIVE, IF KEYWORD NOT FOUND. 
* 
*         USES   X - 1, 3, 4, 5, 6, 7.
*                A - 3, 7.
*                B - 2. 
  
  
 FKA2     BX7    X3 
          MX4    8
          LX3    59-47
          BX1    X4*X3       FIELD NUMBER IF NOT *EB* OR *EL* 
          SA7    FKAA        *TTDC* TABLE ENTRY 
  
 FKA      SUBR               ENTRY/EXIT 
          SB2    TTDC 
          LX1    11-59
 FKA1     SA3    B2+         CURRENT TABLE ENTRY
          BX5    X0*X3
          LX5    11-59
          IX6    X1-X5
          SB2    B2+B1
          ZR     X6,FKA2     IF KEYWORD FOUND 
          PL     X6,FKA1     IF TABLE NOT EXHAUSTED 
          EQ     FKAX        RETURN - ARGUMENT NOT VALID KEYWORD
  
  
 FKAA     CON    0           TABLE ENTRY IF FOUND 
  
 TTDC     SPACE  4,10 
**        TTDC - TABLE OF KEYWORDS. 
* 
*         TABLE ENTRIES ARE CONSTRUCTED FROM THE FOLLOWING FIELDS.
*         DIFFERENT PORTIONS OF THE TABLE USE DIFFERENT FIELDS
*         DEPENDING ON THE PROCESSING ROUTINE.
* 
*         FN = FIELD NUMBER.
*         FV = FIELD VALUE. 
*         FWA = FWA OF *EB* OR *EL* FIELD NUMBER AND FIELD VALUE TABLE. 
*         KW = KEYWORD. 
*         R = ROUTINE.
  
*         12/  KW, 8/  FN, 22/  ,18/  R.
  
  
TTDC      BSS    0           TABLE OF TERMINAL DEFINITION KEYWORDS
          VFD    12/2LBR,8/63B,22/,18/PYN 
          VFD    12/2LBS,8/47B,22/,18/PHB 
          VFD    12/2LB1,8/52B,22/,18/PHB 
          VFD    12/2LB2,8/53B,22/,18/PHB 
          VFD    12/2LCI,8/54B,22/,18/PDB 
          VFD    12/2LCN,8/46B,22/,18/PHB 
          VFD    12/2LCT,8/50B,22/,18/PHB 
  
*         12/  KW, 8/  FN, 4/  , 18/  FV, 18/  R. 
  
          VFD    12/2LDL,8/106B,4/,18/0,18/PDL
  
*         12/  KW, 8/  0, 4/  , 18/  FWA, 18/  R. 
  
          VFD    12/2LEB,8/0,4/,18/PEBA,18/PEB
          VFD    12/2LEL,8/0,4/,18/PEBB,18/PEB
  
*         12/  KW, 8/  FN, 22/  ,18/  R.
  
          VFD    12/2LEP,8/61B,22/,18/PYN 
          VFD    12/2LFA,8/67B,22/,18/PYN 
          VFD    12/2LIC,8/103B,22/,18/PYN
          VFD    12/2LIN,8/64B,22/,18/PIN 
          VFD    12/2LLI,8/55B,22/,18/PDB 
          VFD    12/2LOC,8/104B,22/,18/PYN
          VFD    12/2LOP,8/66B,22/,18/PPO 
          VFD    12/2LPA,8/62B,22/,18/PPA 
          VFD    12/2LPG,8/45B,22/,18/PYN 
          VFD    12/2LPL,8/44B,22/,18/PDB 
          VFD    12/2LPW,8/43B,22/,18/PDB 
          VFD    12/2LSE,8/60B,22/,18/PYN 
          VFD    12/2LTC,8/42B,22/,18/PDB 
  
*         12/  KW, 8/  FN, 4/  , 18/  FV, 18/  R. 
  
          VFD    12/2LXL,8/106B,4/,18/1,18/PDL
          CON    -0          TERMINATION WORD 
 MCB      SPACE  4,15 
**        MCB - MERGE FIELD NUMBERS/FIELD VALUES INTO BUFFER. 
* 
*         THIS ROUTINE ACCEPTS LEFT JUSTIFIED 8-BIT BINARY VALUES AND 
*         MERGES THEM INTO THE BUFFER USED TO MAKE THE *CTI* REQUEST
*         FOR SUBSEQUENT TRANSMISSION TO THE NETWORK SUPERVISOR.  THE 
*         RESULTING BUFFER REQUIRES THAT EACH 8-BIT FIELD NUMBER BE 
*         FOLLOWED BY A CORRESPONDING 8-BIT FIELD VALUE.
* 
*         ENTRY  (X1) = ONE OR MORE LEFT JUSTIFIED 8-BIT BINARY VALUES
*                       THAT REPRESENT FIELD NUMBERS/FIELD VALUES.
*                (B7) = NUMBER OF 8-BIT BINARY VALUES IN (X1).
* 
*         EXIT   (MCBA) UPDATED BY (X1).
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 2, 3, 4, 6, 7. 
*                B - 2, 3, 4, 7.
  
  
 MCB4     SA6    A3+         RESTORE FINISHED WORD TO BUFFER
          SX7    B2 
          SX6    B3 
          SA7    MCBB        SET NEW WORD COUNT 
          SA6    MCBC        SET NEW FIELD POINTER
  
 MCB      SUBR               ENTRY/EXIT 
          SA2    MCBB        BUFFER WORD POINTER
          SA4    MCBE        UPDATE FIELD NUMBER/FIELD VALUE COUNT
          MX0    8
          SX7    B7+X4
          SA3    MCBC        FIELD POINTER
          SB4    -4          (B4) = BIT POSITION INDICATING OVERLAP 
          SA7    A4 
          SB2    X2 
          SB3    X3 
          SA3    MCBA+B2     CURRENT UNFINISHED WORD IN BUFFER
          BX6    X3 
 MCB1     SX4    377B 
          SB3    B3-8 
          SB7    B7-B1
          BX2    X0*X1       EXTRACT 8-BIT BINARY VALUE 
          LX1    8
          LX2    8
          EQ     B3,B4,MCB3  IF VALUE MUST BE DIVIDED 
          LX4    B3 
          LX2    B3 
          BX6    -X4*X6 
          BX6    X2+X6       MERGE 8-BIT BINARY VALUE 
          ZR     B3,MCB2     IF LAST VALUE TO BE MERGED 
          GT     B7,MCB1     IF VALUES YET TO BE MERGED 
          EQ     MCB4        PROCESSING COMPLETE
  
 MCB2     SB3    60 
          SB2    B2+1 
          SA6    A3 
          SA3    A3+1        PRESET (A3)
          BX6    X6-X6
          GT     B7,MCB1     IF VALUES YET TO BE MERGED 
          EQ     MCB4        STAGING REGISTER EMPTY 
  
 MCB3     MX0    -4          RESTORE COMPLETED WORD TO BUFFER 
          BX3    X2 
          AX3    4
          BX6    X0*X6
          BX3    -X0*X3 
          BX6    X3+X6       MERGE HALF OF VALUE
          SA6    A3 
          SA3    A3+B1
          BX6    X6-X6
          MX0    4           POSITION REMAINING HALF OF VALUE 
          SA6    A3          CLEAR NEXT WORD IN BUFFER
          LX2    59-3 
          BX6    X0*X2
          SB3    56 
          MX0    8           RESET HEX MASK 
          SB2    B2+1        INCREMENT WORD COUNT 
          GT     B7,MCB1     IF VALUES YET TO BE MERGED 
          EQ     MCB4        PROCESSING COMPLETE
  
  
 MCBA     BSS    20          SUPERVISORY MESSAGE BUFFER 
 MCBB     DATA   2           WORD POINTER INTO *MCBA* 
 MCBC     DATA   44          POINTER TO BEGINNING OF 8-BIT FIELDS.
 MCBD     VFD    8/PFTC,1/0,1/0,6/SFDM,44/0 
 MCBE     CON    2           FIELD NUMBER/FIELD VALUE COUNT OF *MCBA* 
          SPACE  4,10 
          SPACE  4,10 
*         COMMON DECKS. 
  
*CALL     COMCCDD 
*CALL     COMKZFN 
*CALL     COMCDXB 
*CALL     COMCPOP 
*CALL     COMCUSB 
*CALL     COMCZTB 
          SPACE  4,10 
          END 
