Retro1.org codex

          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