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