147 lines
11 KiB
NASM
147 lines
11 KiB
NASM
* DATA SET UCTRAN41 AT LEVEL 002 AS OF 08/25/98
|
|
* DATA SET UCTRAN41 AT LEVEL 001 AS OF 12/23/97 00001
|
|
TITLE 'U C T R A N SWITCH UPPER CASE TRANSLATION OPTION' 00002
|
|
*********************************************************************** 00003
|
|
* * 00004
|
|
* U C T R A N SWITCH UPPER CASE TRANSLATION OPTION * 00005
|
|
* * 00006
|
|
* CODE FOR CICS 4.1.0 * 00007
|
|
* * 00008
|
|
* THIS PROGRAM IS USED TO SWITCH THE UCTRAN OPTION FOR THE * 00009
|
|
* TERMINAL. AN APPLICATION PROGRAM CAN CALL THIS PROGRAM * 00010
|
|
* AS FOLLOWS: * 00011
|
|
* EXEC CICS LINK PROGRAM(UCTRAN) END-EXEC. * 00012
|
|
* OR * 00013
|
|
* EXEC CICS LINK PROGRAM(UCTRAN) COMMAREA(UCPARM) END-EXEC. * 00014
|
|
* * 00015
|
|
* THE FIRST FORM WILL FLIP THE CURRENT STATUS REGARDLESS OF * 00016
|
|
* THE CURRENT VALUE. THE SECOND FORM WILL SET THE OPTION TO * 00017
|
|
* THE REQUESTED VALUE IF NEEDED. UCPARM IS A 1 BYTE CHARACTER * 00018
|
|
* DEFINED AS 'U' FOR UPPERCASE TRANSLATION, OR 'L' FOR NO * 00019
|
|
* UPPERCASE TRANSLATION. * 00020
|
|
* * 00021
|
|
* IF THE TRANSACTION ID IS 'LC' SET THE LC OPTION. * 00022
|
|
* IF THE TRANSACTION ID IS 'UC' SET THE UC OPTION. * 00023
|
|
* * 00024
|
|
* IF THE PROGRAM IS INVOKED IN AN AOR THE PROGRAM WILL START * 00025
|
|
* ITSELF IN THE TOR WITH A 5 BYTE COMMAREA. THIS AREA WILL * 00026
|
|
* SPECIFY THE FUNCTION, 'U OR L' FOLLOWED BY THE TERMID TO BE * 00027
|
|
* SWITCHED. * 00028
|
|
* * 00029
|
|
* REGISTER USAGE: * 00030
|
|
* * 00031
|
|
* R0 RESERVED * 00032
|
|
* R1 PARM POINTER * 00033
|
|
* R2 * 00034
|
|
* R3 1ST CODE BASE REGISTER * 00035
|
|
* R4 2ND CODE BASE REGISTER * 00036
|
|
* R5 1ST DATA BASE REGISTER * 00037
|
|
* R6 WORK * 00038
|
|
* R7 EIB POINTER * 00039
|
|
* R8 WORK * 00040
|
|
* R9 BCT REGISTER / TEMP TIOA POINTER * 00041
|
|
* R10 TCTTE POINTER * 00042
|
|
* R11 EIB POINTER * 00043
|
|
* R12 * 00044
|
|
* R13 RESERVED * 00045
|
|
* R14 RESERVED * 00046
|
|
* R15 RESERVED * 00047
|
|
* * 00048
|
|
* * 00049
|
|
* * 00050
|
|
* * 00051
|
|
*********************************************************************** 00052
|
|
EJECT 00053
|
|
* XEQU 00054**2
|
|
DFHREGS ADDED BY WB 00055**2
|
|
EJECT 00056
|
|
DFHEISTG DSECT 00057
|
|
SPACE 3 00058
|
|
UCTRANST DS F 00059
|
|
LENGTH DS H 00060
|
|
CAPARM DS 0CL5 * COMMAREA PARM 00061
|
|
CATYPE DS CL1 * TYPE OF COMMAREA 00062
|
|
UCTRANU EQU C'U' * UPPERCASE TRANSLATION 00063
|
|
UCTRANL EQU C'L' * NO UPPERCASE TRANSLATION 00064
|
|
UCTRANF EQU C'F' * FLIP UPPERCASE TRANSLATION 00065
|
|
CATERM DS CL4 * TERMID FOR UCTRAN 00066
|
|
SYSID DS CL4 * SYSID FOR TOR 00067
|
|
SPACE 3 00068
|
|
******************************************************************* 00069
|
|
EJECT 00070
|
|
UCTRAN DFHEIENT CODEREG=(3,4),DATAREG=(5),EIBREG=7 00071
|
|
CLI EIBTRMID,X'40' Q-TERMINAL TASK 00072
|
|
BH GOODTERM BIF YES 00073
|
|
MVC LENGTH,=H'5' 00074
|
|
EXEC CICS RETRIEVE INTO(CAPARM) LENGTH(LENGTH) 00075
|
|
CLC LENGTH,=H'5' 00076
|
|
BNE ABEND BIF NO 00077
|
|
B CKPARM 00078
|
|
ABEND DS 0H 00079
|
|
EXEC CICS ABEND ABCODE('UCTR') 00080
|
|
GOODTERM DS 0H 00081
|
|
MVC CATERM,EIBTRMID 00082
|
|
MVI CATYPE,UCTRANU SET UP FOR UCTRAN ON 00083
|
|
CLC EIBTRNID,=CL4'UC' Q-UPPERCASE TRANSLATE REQUESTED 00084
|
|
BE UCYES BIF YES 00085
|
|
CLC EIBTRNID,=X'A4834040' 00086
|
|
BE UCYES 00087
|
|
MVI CATYPE,UCTRANL SET UP FOR UCTRAN OFF 00088
|
|
CLC EIBTRNID,=CL4'LC' Q-LOWERCASE REQUESTED 00089
|
|
BE UCNO BIF YES 00090
|
|
CLC EIBTRNID,=X'93834040' 00091
|
|
BE UCNO 00092
|
|
CLC EIBCALEN,=H'0' Q-COMMAREA 00093
|
|
BE UCFLIP BIF NO, 00094
|
|
L R1,DFHEICAP GET ADDRESS OF COMMAREA 00095
|
|
MVC CATYPE,0(R1) COPY IT 00096
|
|
CKPARM DS 0H 00097
|
|
CLI CATYPE,UCTRANU Q-UPPERCASE TRANSLATE REQUESTED 00098
|
|
BE UCYES BIF YES 00099
|
|
CLI CATYPE,UCTRANL Q-LOWERCASE REQUESTED 00100
|
|
BE UCNO BIF YES 00101
|
|
UCFLIP DS 0H 00102
|
|
EXEC CICS INQUIRE TERMINAL(CATERM) UCTRANST(UCTRANST) 00103
|
|
CLC UCTRANST,DFHVALUE(UCTRAN) Q-UCTRAN ACTIVE 00104
|
|
BE UCNO BIF YES, TURN IF OFF 00105
|
|
SPACE 1 00106
|
|
UCYES DS 0H 00107
|
|
MVC UCTRANST,DFHVALUE(UCTRAN) 00108
|
|
B UCSET 00109
|
|
UCNO DS 0H 00110
|
|
MVC UCTRANST,DFHVALUE(NOUCTRAN) 00111
|
|
SPACE 1 00112
|
|
UCSET DS 0H ** RETURN ** 00113
|
|
EXEC CICS SET TERMINAL(CATERM) UCTRANST(UCTRANST) 00114
|
|
EXEC CICS INQUIRE TERMINAL(CATERM) REMOTESYSTEM(SYSID) 00115
|
|
CLI SYSID,X'40' 00116
|
|
BNH CKTRAN 00117
|
|
MVC LENGTH,=Y(L'CAPARM) LENGTH OF COMMAREA 00118
|
|
EXEC CICS START TRANSID('UCTR') SYSID(SYSID) FROM(CAPARM) *00119
|
|
LENGTH(LENGTH) 00120
|
|
* IT MAY BE NECESSARY AT A FUTURE TIME TO BUILD A WAIT/POST MECHANISM 00121
|
|
* INTO THE PROCESS HERE TO ENSURE THAT THE BIT IS FLIPPED BEFORE THE 00122
|
|
* USER CAN ENTER THEIR NEXT TRAN. 00123
|
|
B RETURN 00124
|
|
CKTRAN DS 0H ** RETURN ** 00125
|
|
CLC EIBTRNID,=CL4'UC' Q-WAS THIS FOR UC TRAN 00126
|
|
BE CLEAR BIF YES 00127
|
|
CLC EIBTRNID,=X'A4834040' Q-WAS THIS FOR UC TRAN 00128
|
|
BE CLEAR BIF YES 00129
|
|
CLC EIBTRNID,=CL4'LC' Q-WAS THIS FOR LC TRAN 00130
|
|
BE CLEAR BIF YES 00131
|
|
CLC EIBTRNID,=X'93834040' Q-WAS THIS FOR LC TRAN 00132
|
|
BNE RETURN BIF NO 00133
|
|
CLEAR DS 0H 00134
|
|
EXEC CICS SEND CONTROL ERASE FREEKB 00135
|
|
RETURN DS 0H 00136
|
|
EXEC CICS RETURN 00137
|
|
SPACE 3 00138
|
|
PRINT OFF 00139
|
|
LTORG 00140
|
|
PRINT ON 00141
|
|
SPACE 3 00142
|
|
CSECT 001424
|
|
DC CL21'002UCTRAN41 08/25/98' 001425
|
|
END 00143
|