PL/I
Figure 1, in PL/I, extracts information from the z/OS® Communications Server CINIT RU, which carries the BIND image. Part of this information is the screen presentation services information, such as the default screen size and alternate screen size. The alternate screen size is used to determine the model of terminal that is requesting logon. The presented models are searched for a match, and if there is no match, the first model from those presented is used.
DCL 1 CINIT BASED(INSTALL_CINIT_PTR),
2 CINIT_LENG FIXED BIN(15),
2 CINIT_RU CHAR(256);
DCL SAVE_CINIT CHAR(256);
/* Temp save area for CINIT RU */
DCL 1 SCRNSZ BASED(ADDR(SAVE_CINIT)),
2 SPARE CHAR(31),
/* Bypass first part of CINIT and reach */
/* into BIND image carried in CINIT */
2 DHGT BIT(8),
/* Screen default height in BIND PS area */
2 DWID BIT(8),
/* Screen default width in BIND PS area */
2 AHGT BIT(8),
/* Screen alternate height in BIND PS area */
2 AWID BIT(8);
/* Screen alternate width in BIND PS area */
DCL NAME CHAR(2);
/* Used to work up a screen model type */
DCL TERMID PIC'9999' INIT(1) STATIC;
/* Used to work up a unique termid */
DCL ENQ CHAR(8) INIT('AUTOPRG');
/* Used to prevent multiple access to termid */
/* If model name supplied by MTS, bypass model name selection */
IF SELECTED_MODELNAME ¬= ' '
THEN GO TO MODEL_EXIT;
/* Clear the CINIT save area and move in the */
/* z/OS Communications Server CINIT RU.*/
/* This is useful if you fail to recognize the model */
/* of terminal; provide a dump and analyze this data */
SAVE_CINIT = LOW(256);
SUBSTR(SAVE_CINIT,1,CINIT_LEN) = SUBSTR(CINIT_RU,1,CINIT_LEN); /* Now access the screen PS area in the portion of the BIND
image presented in the CINIT RU */
/* using the screen alternate height as a guide to the model
of terminal attempting logon. If this cannot be determined
then default to the first model in the table */
SELECT (AHGT); /* NOW GET SCRN ALTERNATE HEIGHT */
WHEN (12) NAME = 'M1'; /* MODEL 1 */
WHEN (32) NAME = 'M3'; /* 3 */
WHEN (43) NAME = 'M4'; /* 4 */
WHEN (27) NAME = 'M5'; /* 5 */
OTHERWISE NAME = 'M2'; /* 2 */
END;
/* Search the model entries for a matching entry. */
/* The criterion here is that a model definition should*/
/* contain the chars M2 for a model 2, and so on. */
/* For example, L3270M2, L3270M5 */
/* TERMM2, TERMM5 */
IF MODELNAME_COUNT = 0
THEN GO TO EXIT;
DO I = 1 TO MODELNAME_COUNT;
IF INDEX(MODELNAME(I),NAME)
THEN GO TO FOUND_MODEL;
END;
NO_MODEL: /* Matching entry was not found, default to first model*/
SELECTED_MODELNAME = MODELNAME(1);
GO TO MODEL_EXIT;
FOUND_MODEL: /* Move the selected model name to the return area */
SELECTED_MODELNAME = MODELNAME(I);
MODEL_EXIT: /* ENQ to stop multiple updates of counter. */
/* A simple counter is used to generate unique */
/* terminal identities, so concurrent access to */
/* this counter is denied to ensure no two get */
/* the same identifier or update the counter. */
/* To use this method the program must be defined as resident.*/
EXEC CICS ENQ RESOURCE(ENQ);
SELECTED_TERMID = TERMID; /* Set SELECTED_TERMID to
count value */
TERMID = TERMID + 1; /* Increase the count value by 1 */
IF TERMID = 9999 THEN TERMID = 1; /* Reset if too large*/
EXEC CICS DEQ RESOURCE(ENQ);
NAME_EXIT:
INSTALL_RETURN_CODE = LOW(1);
/* Set stat field to X'00' to allow
logon to be processed */
GO TO EXIT;
END INSTALL;