BLDABH
          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 
