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