IDENT BLDABH
ENTRY BLDABH
ENTRY GETABH
*COMMENT BLDABH - BUILD APPLICATION BLOCK HEADER.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE BLDABH - BUILD APPLICATION BLOCK HEADER.
SPACE 4
***** BLDABH - BUILD APPLICATION BLOCK HEADER.
* W.E. MARTIN. 77/01/31.
* COMMON TEXT DEFINITION.
*CALL COMCMAC
*CALL COMKFLD
*CALL COMKMAC
*CALL COMKNWF
*CALL COMSPRD
BLDABH SPACE 4,35
*** BLDABH - BUILD APPLICATION BLOCK HEADER.
*
* *BLDABH* WILL FORMAT THE APPLICATION BLOCK HEADER, *ABH*,
* FOR A FORTRAN EXTENDED OR COBOL USER. SINCE THE HEADER
* IS PACKED INTO FIELDS THAT ARE MEANINGFUL ONLY TO THE
* SUPERVISORY MESSAGE PROCESSOR, THIS ROUTINE WILL MAP USER
* SUPPLIED (KEYWORD,VALUE) PAIRS INTO THE APPROPRIATE FIELDS
* VIA TABLE LOOKUP OF THE KEYWORD.
*
* CALL FORMAT -
*
* FORTRAN EXTENDED -
*
* CALL BLDABH(KEYWORD1,VALUE1, ... )
*
* COBOL -
*
* ENTER BLDABH USING KEYWORD1,VALUE1, ... .
*
* WHERE - KEYWORD1 = MAY BE OF THE FORM 3CXXX, WHERE C IS THE
* HOLLERITH CHARACTER DESCRIPTOR, L OR H,
* AND XXX IS ANY OF THE KEYWORDS WHOSE
* UNION DETERMINES THE SET OF FIELDS IN THE
* *ABH*.
*
* VALUE1 = VALUE TO BE ASSOCIATED WITH PRECEDING
* KEYWORD.
* FORTRAN EXTENDED = INTEGER.
* COBOL = COMPUTATIONAL-1.
VFD 42/0LBLDABH,18/BLDABH
BLDABH SUBR ENTRY/EXIT
SX6 A0
SB1 1
SA2 A1 READ TERMINAL NAME
SA6 BLDA SAVE (A0)
SA3 =XABH. DEFAULT APPLICATION BLOCK HEADER
ZR X1,BLD2 IF NO ARGUMENTS - ABORT TASK
BX0 X3
SA1 X2
* PROCESS (KEYWORD,VALUE) PAIRS.
BLD1 RJ ZFN ZERO FILL NAME
RJ FKA FIND KEYWORD ARGUMENT
NZ X6,BLD2 IF KEYWORD NOT FOUND
MX1 1
SB5 B3+B4
AX1 B4 FORM MASK
SB5 B5+B1 INCREMENT SHIFT COUNT
SA2 A2+B1 READ VALUE FIELD
LX1 B5
ZR X2,BLD2 IF PREMATURE END OF ARGUMENT LIST
SA3 X2
BX0 -X1*X0
UX3 X3 UNPACK POSSIBLE COBOL ARGUMENT
LX3 B3
BX0 X0+X3 MERGE VALUE
SA2 A2+B1
SA1 X2 NEXT KEYWORD
NZ X2,BLD1 IF NOT END OF ARGUMENT LIST
BX6 X0
SA1 BLDA SAVE (A0)
SA6 =XABH.
SA0 X1
EQ BLDABHX RETURN
* ABORT TASK DUE TO ARGUMENT ERROR.
BLD2 SA1 BLDABH
MX0 30
LX1 30
SA2 X1-1 READ *RJ* FROM CALLING PROGRAM
BX6 -X0*X2 SET TRACE-BACK WORD INTO BUFFER
SA6 BLDB
ARGERR A6 EXIT TO EXECUTIVE
GETABH SPACE 4,10
*** GETABH - GET APPLICATION BLOCK HEADER.
*
* GET APPLICATION BLOCK HEADER MAKES A *CTI* REQUEST
* FOR RETURN OF THE LAST APPLICATION BLOCK HEADER THAT
* ACCOMPANIED A TERMINAL REQUEST. THE KEYWORDS ARE
* LOOKED UP, THE APPROPRIATE FIELDS INTERROGATED AND
* RETURNED TO THE LOCATIONS SPECIFIED IN THE PARAMETER
* LIST. IF THE TERMINAL IS LOGGED IN, THE STATUS WORD
* WILL BE RETURNED NON-ZERO; FURTHER, THE TASK WILL BE
* ABORTED IF THE REQUEST ATTEMPTS TO CROSS DATA BASES.
*
* CALL FORMAT -
*
* ALL CALLS ARE EXACTLY AS SPECIFIED IN *BLDABH*, WITH
* THE VALUES BEING RETURNED TO THE USER, INSTEAD OF
* BEING ACCEPTED.
VFD 42/0LGETABH,18/GETABH
GETABH SUBR ENTRY/EXIT
MX0 42
SA2 X1 TERMINAL NAME
SB1 1
ZR X1,GAH3 IF NO PARAMETERS
SX6 A0
UX1,B6 X2
SA6 BLDA
ZR X1,GAH1 IF NO TERMINAL NAME
BX1 X0*X2
RJ ZFN ZERO FILL NAME
GAH1 BX6 X1
SA3 A1+B1
SA6 BLDB
SX7 X3 (X7) = ADRESS OF STATUS PARAMETER
SX5 A1+ (X5) = ADDRESS OF PARAMETER LIST
SA7 A6+B1
GETABH A6
SA2 BLDB+2 APPLICATION BLOCK HEADER
BX0 X2 (X0) = ABH
SA2 BLDB+1 ADDRESS OF LOGGIN STATUS WORD
SA3 X2 (X3) = TERMINAL LOGIN STATUS
UX3 X3
NZ X3,GAH3 IF TERMINAL LOGGED IN
GAH2 SA1 BLDA
SA0 X1+
EQ GETABHX RETURN - TERMINAL NOT LOGGED IN
GAH3 SA2 X5+2 READ ADDRESS OF KEYWORD
ZR X2,GAH5 IF SHORT ARGUMENT LIST
SA1 X2+
GAH4 RJ ZFN ZERO FILL NAME
RJ FKA FIND KEYWORD ARGUMENT
NZ X6,GAH5 IF KEYWORD NOT FOUND
MX3 1
SB5 B3+B4 (B5) = SHIFT COUNT TO POSITION MASK
AX3 B4
SB5 B5+B1
LX3 B5 POSITION MASK
SA2 A2+B1 READ ADDRESS OF VALUE PARAMETER
BX6 X0*X3
AX6 B3
ZR X2,GAH5 IF NO LOCATION FOR KEYWORD
PX6 X6
SA6 X2
SA2 A2+B1 READ ADDRESS OF KEYWORD PARAMETER
SA1 X2 READ NEXT KEYWORD
NZ X2,GAH4 IF SHOULD CONTINUE PROCESSING
EQ GAH2 RESTORE (A0) AND RETURN
* ABORT TASK DUE TO ARGUMENT ERRORS.
GAH5 SA1 GETABH
MX0 30
LX1 30
SA2 X1-1 READ *RJ* FROM CALLING PROGRAM
BX6 -X0*X2 SET TRACE-BACK WORD INTO BUFFER
SA6 BLDB
ARGERR A6 EXIT TO EXECUTIVE
SPACE 4,10
** FKA - FIND KEYWORD ARGUMENT.
*
* FIND KEYWORD ARGUMENT FINDS A KEYWORD PARAMETER AND RETURNS
* A FIELD WIDTH AND SHIFT COUNT WITH WHICH TO FORM A MASK IN
* THE APPROPRIATE FIELD OF THE *ABH*.
*
* ENTRY (X1) = KEYWORD TO BE FOUND - LEFT JUSTIFIED.
*
* EXIT (B3) = SHIFT COUNT FOR A MASK RIGHT JUSTIFIED.
* (B4) = FIELD WIDTH FOR MASK OF KEYWORD.
* (X6) = NON-ZERO - IF ARGUMENT NOT FOUND.
*
* USES X - 3, 4, 5, 6, 7.
* B - 3, 4.
* A - 3.
FKA SUBR ENTRY/EXIT
MX4 18
SB3 TABHL
MX7 -6
FKA1 SA3 TABH-1+B3 CURRENT ENTRY
BX5 X4*X3
SB3 B3-B1
BX6 X5-X1
ZR X6,FKA2 IF KEY WORD FOUND
GE B3,FKA1 IF TABLE NOT EXHAUSTED
EQ FKAX RETURN - ARGUMENT NOT VALID KEYWORD
FKA2 BX4 -X7*X3
AX3 6
SB3 X4 (B3) = SHIFT COUNT
BX4 -X7*X3
SB4 X4 (B4) = FIELD WIDTH OF KEYWORD
EQ FKAX RETURN
SPACE 4,10
BLDA BSS 1 TEMPORARY STORAGE FOR (A0)
BLDB BSS 3 PARAMETER BLOCK FOR *CTI* REQUEST
SPACE 4
** TABH - TABLE OF KEYWORD PARAMETERS.
*
*T 18/KEYWORD, 30/0, 6/MASK, 6/BIT
*
* WHERE - MASK = MASK WIDTH-1.
*
* BIT = BEGINNING BIT POSITION OF FIELD.
TABH BSS 0
VFD 18/3LABT,30/0,6/AHBTN-1,6/AHBTS-AHBTN+1
VFD 18/3LADR,30/0,6/AHADN-1,6/AHADS-AHADN+1
VFD 18/3LABN,30/0,6/AHBNN-1,6/AHBNS-AHBNN+1
VFD 18/3LACT,30/0,6/AHCTN-1,6/AHCTS-AHCTN+1
VFD 18/3LIBU,30/0,6/AHBUN-1,6/AHBUS-AHBUN+1
VFD 18/3LRFE,30/0,6/AHRFN-1,6/AHRFS-AHRFN+1
VFD 18/3LNFE,30/0,6/AHNFN-1,6/AHNFS-AHNFN+1
VFD 18/3LXPT,30/0,6/AHPTN-1,6/AHPTS-AHPTN+1
VFD 18/3LCAN,30/0,6/AHCNN-1,6/AHCNS-AHCNN+1
VFD 18/3LBIT,30/0,6/AHPRN-1,6/AHPRS-AHPRN+1
VFD 18/3LAIM,30/0,6/AHPRN-1,6/AHPRS-AHPRN+1
VFD 18/3LPEF,30/0,6/AHPRN-1,6/AHPRS-AHPRN+1
VFD 18/3LTLC,30/0,6/AHLCN-1,6/AHLCS-AHLCN+1
TABHL EQU *-TABH LENGTH OF KEYWORD PARAMETER TABLE
SPACE 4
* COMMON DECKS.
*CALL COMKZFN
SPACE 4
END