|
Before there was MQSeries, there was TCAM
|
|---|
|
This TCAM dedicated 1050 terminal line handler was written for Chrysler's parts supplier network in 1976. BCD dedicated 1050 terminals were located in the production control department. Dialup 1050 and TXW 33/35 terminals were located in remote parts supplier plants. MQSeries gurus may recognize some macros and a little pre-HLASM code. |
MHDD1050 STARTMH LC=OUT,CONV=YES,STOP=YES,TSOMH=NO
*
* The original line handler program was written in BTAM
* and supported start-stop devices only.
*
* When adding bisync support, the start-stop BTAM
* line handler was rewritten in TCAM. The
* rewrite had to be done without changing the
* COBOL application programs. The programs were
* dependent on having a 21 byte header preceding
* the message so the COBOL programs would know how
* to format the response.
*
* In TCAM, there were line handlers for dialup 1050,
* dedicated 1050, dialup TWX, unsupported TELEX, 3270 bisync
* terminals and offline (disk) input. 3270 bisync
* messages were reformated into dialup TWX
* messages so the COBOL programs could process
* them without changing the application code.
* The TWX responses were then reformatted for
* 3270 output.
*
* For 1050 dedicated terminals,
* Some lines have only a keyboard terminal
* Some lines have a keyboard and card reader terminal
* Some lines have only card readers
* And some lines are multidropped
* Different line configurations have different paths
* through the message handler
*
* This is the dedicated 1050 start-stop line handler. In it,
* . Messages come into TCAM from a terminal and are sent to a
* program (INHDR)
* . Responses come into TCAM from a program and are sent to a
* terminal (OUTHDR)
* . Unidentified messages are sent to the dead letter queue
*
INHDR PATH=(OMSGPATH,1)
CODE , Change message from BCD to EBCDIC code
XC W4LEN,W4LEN
MHGET WORK=W4HDR,RESERVE=YES
IF (LTR,15,15,NZ)
TERRSET
ELSE
* Path if buffer has good data
LOCOPT HCLN,(6)
*
* Prefix the message with a header for the DIAS application
* (Dynamic Inventory Analysis System) COBOL program
*
IF (LTR,15,15,Z)
MVC W4DATA(21),(R6)
MHPUT WORK=W4HDR,RESERVE=0
ELSE
TERRSET
ENDIF
PRIORITY 7
FORWARD DEST=CL8'TDIAS',THRESH=50
IF (LTR,15,15,NZ)
TERRSET
ENDIF
LOCK
IF (LTR,15,15,NZ)
TERRSET
ENDIF
ENDIF
INHDR (PATH=(OMSGPATH,X'0C')
CODE
MHGET WORK=W4HDR,RESERVE=YES
IF (LTR,15,15,NZ)
TERRSET
ELSE
LOCOPT HCLN,(6)
IF (LTR,15,15,Z)
MVC W4DATA(21),0(R6)
L R5,IEDADBUF
L R5,DLCB(R5)
ICM R4,B'0111',DINV(R5)
MVC W4DATA+2(2),0(R4)
IF (CLI,0(R4),EQ,GRNDRPD) If Grand Rapids reader
PATH 8,OMSGPATH
ELSE
IF (CLI,0(R4),EQ,CHICAGO) If Chicago reader
PATH 4,OMSGPATH
ELSE
TERRSET
ENDIF
ENDIF
*
* If it is the 1st device on a multidrop line
* bump the polling pointer to point to the second device
* If it is the 2nd device on a multidrop line
* bump the polling pointer to point to the first device
* as multidrop lines have card readers and we
* don't want one card reader to monopolize the line
*
IF (CLI,2(R4),EQ,RDR1)
AH R4,=H'3' bump to reader 2
STCM R4,B'0111',DINV(R5)
ELSE
IF (CLI,2(R4),EQ,RDR2)
SH R4,=H'3' bump pointer to 1st device
STCM R4,B'0111',DINV(R5)
ELSE
TERRSET
ENDIF
ENDIF
INHDR PATH=(OMSGPATH,2)
CODE
XC W4LEN,W4LEN zero byte count
MHGET WORK=24HDR,RESERVE=YES
IF (LTF,15,15,NZ)
TERRSET
ELSE
LOCOPT HCLN,(6)
*
* Get buffer address from AVT
* Get Line Control Block address from buffer
* Get invitation list from LCB
* Move the polling chars to message header
* If polling was for a keyboard-reader
* Point back to the keyboard device
* And save the new polling pointer in the LCB
*
IF (LTR,15,15,Z)
MVC W4DATA(21),0(R6)
L R5,IEDADBUF
L R5,DLCB(R5)
ICM R4,B'0111',DINV(R5)
MVC W4DATA+2(2),0(R4)
IF (CLI,1(R4),EQ,RDR)
SH R4,=H'3'
STCM R4,B'0111',DINV(R5)
ENDIF
*
* Get code translate table address from the line group DCB
* Translate the 1050 polling characters to EBCDIC
* for the appl pgm
* And put the message header back in the buffer
*
ICM R6,B'0111',DED1050+DTBL
TR W4DATA+2(2),4(R6)
MHPUT WORK=W4HDR,RESERVE=0
IF (LTR,15,15,NZ)
TERRSET
ENDIF
ELSE
TERRSET
ENDIF
PRIORITY 7
*
* Send message header-translated msg to the program
*
FORWARD DEST=CL8'TDIAS',THRESH=50
IF (LTR,15,15,NZ)
TERRSET
ENDIF
LOCK
IF (LTR,15,15,NZ)
TERRSET
ENDIF
ENDIF
INMSG
CANCELMG X'0307EDF7FF'
MSGGEN 'X0307EDF7FF',C'REJECT TCAMI'
INEND
OUTHDR PATH=(OMSGPATH,3)
* Path for keyboard only,
* reader only,
* keyboard and reader lines
MSGFORM BLOCK=232
MSGEDIT ((R,,,(21))),BLANK=NO Strip message header
IF (LTR,14,14,NZ)
TERRSET
ENDIF
CODE
OUTHDR PATH=(OMSGPATH,4)
MSGFORM BLOCK=232
LA R4,CVT
L R4,0(R4) CVT addr from hex10 in CPU
L R4,CVTAVTAD(R4) Dispatcher addr from CVT
L R4,0(R4) Word 1 is AVT addr
L R4,AVTRNMPT(,R4) Terminal name table addr from AVT
USING TERMNAME,R4
LH R5,TNTLEN Number terminal name table entries
LA R4,TNTFIRST Address of 1 terminal name entry
DROP R4
USING TNTENTRY,R4 Base entry DSECT on R4
CHISCAN DS 0H
IF (CLC,TNTNAME,EQ,RDRRDR) Look for reader-reader line
ICM R6,,B'0111',TNTADDR
USING TERMTBL,R6 Address of terminal control block
ELSE
ICM R6,B'0111',TNTADDR Terminal entry in table
LA R4,11(,R4) Address of next termname in table
BCT R5,CHISCAN
ENDIF
DROP R4
LA R7,DEVINFO(R6) Addr device dependent info
SR R8,R8
IC R8,TRMOPNO Get number of options
LA R7,0(R8,R7) Point to device dependent field
IF (CLI,2(R8),EQ,PRINTER) If this is a printer
MVI 1(R8),CHICAGO Move Chicago terminal in list
ELSE
TERRSET
ENDIF
DROP R6
* No one said this was device independent
LA R9,DEDBITS
MSGEDIT ((R,,,(21))),BLANK=NO
CODE
OUTHDR PATH=(OMSGPATH,8)
* Path for Grand Rapids reader
MSGFORM BLOCK=232
LA R4,CVT CVT addr from loc hex10 in CPU
L R4,0(R4)
L R4,CVTAVTAD(R4) Dispatcher addr from CVT
L R4,0(R4) Dispatcher word 1 is AVT addr
L R4,AVTRNMPT(,R4) Terminal name table addr
USING TERMNAME,R4
LH R5,TNTLEN # terminal name table entries
LA R4,TNTFIRST R4=addr terminal name entry
DROP R4
USING TNTENTRY,R4 Base entry DSECT on R4
GRSCAN DS 0H
IF (CLC,TNTNAME,EQ,RDRRDR) Look for reader-reader line
ICM R6,,B'0111',TNTADDR) terminal control block
USING TERMTBL,R6 in R6
ELSE
LA R4,11(,R4) Address next termname in table
BCT R5,GRSCAN
TERRSET
ENDIF
DROP R4
LA R7,DEVINFO(R6) Addr device dependent
SR R8,R8
IC R8,TRMOPNO Get number of options
LA R7,0(R8,R7) Point to device dependent field
IF (CLI,2(R8),EQ,PRINTER) If this is a printer
MVI 1(R8),GRNDRPD Grand Rapids terminal to list
ELSE
TERRSET
ENDIF
DROP R6
* No one said this was device independent
LA R9,DEDBITS
MSGEDIT ((R,,,(21))),BLANK=NO
CODE
OUTMSG
* Send garbage to dead letter queue
REDIRECT X'0307EDF7FF',DEST=CL'TDLQ'
MSGGEN X'0307EDF7FF',C' TCAMO' Error message
OUTEND
*
W4HDR DS 0H
DC AL2(L'W4DATA)
W4LEN DS H
DS H
W4DATA DS CL232 Data area
DEDBITS DC XL5'00'
DLCB EQU 12 Displacement LCB in buffer
DINV EQU 97 Displacement polling chars in LCB
DTBL EQU 33 Displacement translate table
RDR EQU X'00' 1050 reader polling character
DADDR EQU X'29' Displacement addressing chars
PRINTER EQU X'13' Any output prt device
RDR1 EQU X'01' RDR1 index in poll list
RDR2 EQU X'02' RDR2 index in poll list
RDRRDR DC CL8'T21' Name of rdr/rdr terminal macro
DEVINFO EQU X'14' Device dependent data displacement
CVT EQU X'10' CVT addr location
CVTAVTAD EQU X'F0' TCAM dispatcher addr in CVT
AVTRNMPT EQU X'1A8' Termname table addr in AVT
CHICAGO EQU X'25'
GRNDRPD EQU X'67
LTORG
=V(IEDQGP)
=H'3'
=H'51'
*
* This is the terminal definition for the 1050
* multidrop reader-reader line
* Chicago card reader is 250D
* Grand Rapids card reader is 670D
* Main storage only queues
* The alternate destination is the dead letter queue
* The 21 byte header is defined in the terminal
* definition OPDATA parm
*
T21 TERMINAL QBY=T,
DCB=DED1050,
RLN=21,
TERM-1050,
QUEUES=MO,
UTERM=NO,
ALTDEST=TDLQ,
FEATURE=NOATTN,
LEVEL=(4,7),
OPDATA=(1,40,F6,21,40,0,0,1,40404040,
0,0,40,80,000,1,1,160,167,0,0,T21,0C),
ADDR=2513
*
* This is the dedicated 1050 DCB definition
*
DED1050 DCB DSORG=TX,MACRF=(G,P),DDNAME=(DED1050,SCT=105F,
INVLIST=
(I1,,,I2,,,I3,,,I4,,,I5,,,I6,,,I7,,,I8,,,
I9,,,I10,,,I11,,,I12,,,I13,,,I14,,,I15,,,I16,,,
I17,,,I18,,,I19,,,I20,,,I21,,,I22),MH=MHDD1050,
TRANS=105F
*
* To DIAS
*
TDIAS TPROCESS PCB=PCBDIAS,LEVEL=(1,4,7,11,15),QUEUES=MO
*
* Dead letter queue
*
TDLQ TPROCESS PCB=PCBDLQ,LEVEL=(1,4,7,11),QUEUES=MO
|