Deck BLDABH

Library Member Format: MODIFY

Source

Seq #  *Modification Id* Act 
----------------------------+
00001  M00S00001.bldabh  +++|          IDENT  BLDABH
00002  M00S00002.bldabh  +++|          ENTRY  BLDABH
00003  M00S00003.bldabh  +++|          ENTRY  GETABH

Line S00004 Modification History
`M01` (Removed by)	`ns2440`

Seq #  *Modification Id* Act 
----------------------------+
00004  M01S00004.ns2440  ---|*COMMENT  BUILD APPLICATION BLOCK HEADER.

Line S00001 Modification History
`M01` (Added by)	`ns2440`

Seq #  *Modification Id* Act 
----------------------------+
00005  M01S00001.ns2440  +++|*COMMENT  BLDABH - BUILD APPLICATION BLOCK HEADER.

Line S00005 Modification History
`M01` (Removed by)	`281l803`

Seq #  *Modification Id* Act 
----------------------------+
00006  M01S00005.281l803 ---|          COMMENT COPYRIGHT CONTROL DATA CORP.  1978.

Line S00001 Modification History
`M01` (Added by)	`281l803`

Seq #  *Modification Id* Act 
----------------------------+
00007  M01S00001.281l803 +++|          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
00008  M00S00006.bldabh  +++|          TITLE  BLDABH - BUILD APPLICATION BLOCK HEADER.
00009  M00S00007.bldabh  +++|          SPACE  4
00010  M00S00008.bldabh  +++|*****     BLDABH - BUILD APPLICATION BLOCK HEADER.
00011  M00S00009.bldabh  +++|*         W.E. MARTIN.       77/01/31.
00012  M00S00010.bldabh  +++|
00013  M00S00011.bldabh  +++|
00014  M00S00012.bldabh  +++|*         COMMON TEXT DEFINITION.
00015  M00S00013.bldabh  +++|
00016  M00S00014.bldabh  +++|
00017  M00S00015.bldabh  +++|*CALL     COMCMAC
00018  M00S00016.bldabh  +++|*CALL     COMKFLD
00019  M00S00017.bldabh  +++|*CALL     COMKMAC
00020  M00S00018.bldabh  +++|*CALL     COMKNWF
00021  M00S00019.bldabh  +++|*CALL     COMSPRD
00022  M00S00020.bldabh  +++| BLDABH   SPACE  4,35
00023  M00S00021.bldabh  +++|***       BLDABH - BUILD APPLICATION BLOCK HEADER.
00024  M00S00022.bldabh  +++|*
00025  M00S00023.bldabh  +++|*         *BLDABH* WILL FORMAT THE APPLICATION BLOCK HEADER, *ABH*,
00026  M00S00024.bldabh  +++|*         FOR A FORTRAN EXTENDED OR COBOL USER.  SINCE THE HEADER
00027  M00S00025.bldabh  +++|*         IS PACKED INTO FIELDS THAT ARE MEANINGFUL ONLY TO THE
00028  M00S00026.bldabh  +++|*         SUPERVISORY MESSAGE PROCESSOR, THIS ROUTINE WILL MAP USER
00029  M00S00027.bldabh  +++|*         SUPPLIED (KEYWORD,VALUE) PAIRS INTO THE APPROPRIATE FIELDS
00030  M00S00028.bldabh  +++|*         VIA TABLE LOOKUP OF THE KEYWORD.
00031  M00S00029.bldabh  +++|*
00032  M00S00030.bldabh  +++|*         CALL FORMAT -
00033  M00S00031.bldabh  +++|*
00034  M00S00032.bldabh  +++|*         FORTRAN EXTENDED -
00035  M00S00033.bldabh  +++|*
00036  M00S00034.bldabh  +++|*         CALL BLDABH(KEYWORD1,VALUE1, ... )
00037  M00S00035.bldabh  +++|*
00038  M00S00036.bldabh  +++|*         COBOL -
00039  M00S00037.bldabh  +++|*
00040  M00S00038.bldabh  +++|*         ENTER BLDABH USING KEYWORD1,VALUE1, ... .
00041  M00S00039.bldabh  +++|*
00042  M00S00040.bldabh  +++|*         WHERE - KEYWORD1 = MAY BE OF THE FORM 3CXXX, WHERE C IS THE
00043  M00S00041.bldabh  +++|*                            HOLLERITH CHARACTER DESCRIPTOR, L OR H,
00044  M00S00042.bldabh  +++|*                            AND XXX IS ANY OF THE KEYWORDS WHOSE
00045  M00S00043.bldabh  +++|*                            UNION DETERMINES THE SET OF FIELDS IN THE
00046  M00S00044.bldabh  +++|*                            *ABH*.
00047  M00S00045.bldabh  +++|*
00048  M00S00046.bldabh  +++|*                 VALUE1 = VALUE TO BE ASSOCIATED WITH PRECEDING
00049  M00S00047.bldabh  +++|*                          KEYWORD.
00050  M00S00048.bldabh  +++|*                          FORTRAN EXTENDED = INTEGER.
00051  M00S00049.bldabh  +++|*                          COBOL = COMPUTATIONAL-1.
00052  M00S00050.bldabh  +++|
00053  M00S00051.bldabh  +++|
00054  M00S00052.bldabh  +++|          VFD    42/0LBLDABH,18/BLDABH
00055  M00S00053.bldabh  +++| BLDABH   SUBR               ENTRY/EXIT
00056  M00S00054.bldabh  +++|          SX6    A0
00057  M00S00055.bldabh  +++|          SB1    1
00058  M00S00056.bldabh  +++|          SA2    A1          READ TERMINAL NAME
00059  M00S00057.bldabh  +++|          SA6    BLDA        SAVE (A0)
00060  M00S00058.bldabh  +++|          SA3    =XABH.      DEFAULT APPLICATION BLOCK HEADER
00061  M00S00059.bldabh  +++|          ZR     X1,BLD2     IF NO ARGUMENTS - ABORT TASK
00062  M00S00060.bldabh  +++|          BX0    X3
00063  M00S00061.bldabh  +++|          SA1    X2
00064  M00S00062.bldabh  +++|
00065  M00S00063.bldabh  +++|*         PROCESS (KEYWORD,VALUE) PAIRS.
00066  M00S00064.bldabh  +++|
00067  M00S00065.bldabh  +++| BLD1     RJ     ZFN         ZERO FILL NAME
00068  M00S00066.bldabh  +++|          RJ     FKA         FIND KEYWORD ARGUMENT
00069  M00S00067.bldabh  +++|          NZ     X6,BLD2     IF KEYWORD NOT FOUND
00070  M00S00068.bldabh  +++|          MX1    1
00071  M00S00069.bldabh  +++|          SB5    B3+B4
00072  M00S00070.bldabh  +++|          AX1    B4          FORM MASK
00073  M00S00071.bldabh  +++|          SB5    B5+B1       INCREMENT SHIFT COUNT
00074  M00S00072.bldabh  +++|          SA2    A2+B1       READ VALUE FIELD
00075  M00S00073.bldabh  +++|          LX1    B5
00076  M00S00074.bldabh  +++|          ZR     X2,BLD2     IF PREMATURE END OF ARGUMENT LIST
00077  M00S00075.bldabh  +++|          SA3    X2
00078  M00S00076.bldabh  +++|          BX0    -X1*X0
00079  M00S00077.bldabh  +++|          UX3    X3          UNPACK POSSIBLE COBOL ARGUMENT
00080  M00S00078.bldabh  +++|          LX3    B3
00081  M00S00079.bldabh  +++|          BX0    X0+X3       MERGE VALUE
00082  M00S00080.bldabh  +++|          SA2    A2+B1
00083  M00S00081.bldabh  +++|          SA1    X2          NEXT KEYWORD
00084  M00S00082.bldabh  +++|          NZ     X2,BLD1     IF NOT END OF ARGUMENT LIST
00085  M00S00083.bldabh  +++|          BX6    X0
00086  M00S00084.bldabh  +++|          SA1    BLDA        SAVE (A0)
00087  M00S00085.bldabh  +++|          SA6    =XABH.
00088  M00S00086.bldabh  +++|          SA0    X1
00089  M00S00087.bldabh  +++|          EQ     BLDABHX     RETURN
00090  M00S00088.bldabh  +++|
00091  M00S00089.bldabh  +++|*         ABORT TASK DUE TO ARGUMENT ERROR.
00092  M00S00090.bldabh  +++|
00093  M00S00091.bldabh  +++| BLD2     SA1    BLDABH
00094  M00S00092.bldabh  +++|          MX0    30
00095  M00S00093.bldabh  +++|          LX1    30
00096  M00S00094.bldabh  +++|          SA2    X1-1        READ *RJ* FROM CALLING PROGRAM
00097  M00S00095.bldabh  +++|          BX6    -X0*X2      SET TRACE-BACK WORD INTO BUFFER
00098  M00S00096.bldabh  +++|          SA6    BLDB
00099  M00S00097.bldabh  +++|          ARGERR A6          EXIT TO EXECUTIVE
00100  M00S00098.bldabh  +++|
00101  M00S00099.bldabh  +++| GETABH   SPACE  4,10
00102  M00S00100.bldabh  +++|***       GETABH - GET APPLICATION BLOCK HEADER.
00103  M00S00101.bldabh  +++|*
00104  M00S00102.bldabh  +++|*         GET APPLICATION BLOCK HEADER MAKES A *CTI* REQUEST
00105  M00S00103.bldabh  +++|*         FOR RETURN OF THE LAST APPLICATION BLOCK HEADER THAT
00106  M00S00104.bldabh  +++|*         ACCOMPANIED A TERMINAL REQUEST.  THE KEYWORDS ARE
00107  M00S00105.bldabh  +++|*         LOOKED UP, THE APPROPRIATE FIELDS INTERROGATED AND
00108  M00S00106.bldabh  +++|*         RETURNED TO THE LOCATIONS SPECIFIED IN THE PARAMETER
00109  M00S00107.bldabh  +++|*         LIST.  IF THE TERMINAL IS LOGGED IN, THE STATUS WORD
00110  M00S00108.bldabh  +++|*         WILL BE RETURNED NON-ZERO; FURTHER, THE TASK WILL BE
00111  M00S00109.bldabh  +++|*         ABORTED IF THE REQUEST ATTEMPTS TO CROSS DATA BASES.
00112  M00S00110.bldabh  +++|*
00113  M00S00111.bldabh  +++|*         CALL FORMAT -
00114  M00S00112.bldabh  +++|*
00115  M00S00113.bldabh  +++|*         ALL CALLS ARE EXACTLY AS SPECIFIED IN *BLDABH*, WITH
00116  M00S00114.bldabh  +++|*         THE VALUES BEING RETURNED TO THE USER, INSTEAD OF
00117  M00S00115.bldabh  +++|*         BEING ACCEPTED.
00118  M00S00116.bldabh  +++|
00119  M00S00117.bldabh  +++|
00120  M00S00118.bldabh  +++|          VFD    42/0LGETABH,18/GETABH
00121  M00S00119.bldabh  +++| GETABH   SUBR               ENTRY/EXIT
00122  M00S00120.bldabh  +++|          MX0    42
00123  M00S00121.bldabh  +++|          SA2    X1          TERMINAL NAME
00124  M00S00122.bldabh  +++|          SB1    1
00125  M00S00123.bldabh  +++|          ZR     X1,GAH3     IF NO PARAMETERS
00126  M00S00124.bldabh  +++|          SX6    A0
00127  M00S00125.bldabh  +++|          UX1,B6 X2
00128  M00S00126.bldabh  +++|          SA6    BLDA
00129  M00S00127.bldabh  +++|          ZR     X1,GAH1     IF NO TERMINAL NAME
00130  M00S00128.bldabh  +++|          BX1    X0*X2
00131  M00S00129.bldabh  +++|          RJ     ZFN         ZERO FILL NAME
00132  M00S00130.bldabh  +++| GAH1     BX6    X1
00133  M00S00131.bldabh  +++|          SA3    A1+B1
00134  M00S00132.bldabh  +++|          SA6    BLDB
00135  M00S00133.bldabh  +++|          SX7    X3          (X7) = ADRESS OF STATUS PARAMETER
00136  M00S00134.bldabh  +++|          SX5    A1+         (X5) = ADDRESS OF PARAMETER LIST
00137  M00S00135.bldabh  +++|          SA7    A6+B1
00138  M00S00136.bldabh  +++|          GETABH A6
00139  M00S00137.bldabh  +++|          SA2    BLDB+2      APPLICATION BLOCK HEADER
00140  M00S00138.bldabh  +++|          BX0    X2          (X0) = ABH
00141  M00S00139.bldabh  +++|          SA2    BLDB+1      ADDRESS OF LOGGIN STATUS WORD
00142  M00S00140.bldabh  +++|          SA3    X2          (X3) = TERMINAL LOGIN STATUS
00143  M00S00141.bldabh  +++|          UX3    X3
00144  M00S00142.bldabh  +++|          NZ     X3,GAH3     IF TERMINAL LOGGED IN
00145  M00S00143.bldabh  +++| GAH2     SA1    BLDA
00146  M00S00144.bldabh  +++|          SA0    X1+
00147  M00S00145.bldabh  +++|          EQ     GETABHX     RETURN - TERMINAL NOT LOGGED IN
00148  M00S00146.bldabh  +++|
00149  M00S00147.bldabh  +++| GAH3     SA2    X5+2        READ ADDRESS OF KEYWORD
00150  M00S00148.bldabh  +++|          ZR     X2,GAH5     IF SHORT ARGUMENT LIST
00151  M00S00149.bldabh  +++|          SA1    X2+
00152  M00S00150.bldabh  +++| GAH4     RJ     ZFN         ZERO FILL NAME
00153  M00S00151.bldabh  +++|          RJ     FKA         FIND KEYWORD ARGUMENT
00154  M00S00152.bldabh  +++|          NZ     X6,GAH5     IF KEYWORD NOT FOUND
00155  M00S00153.bldabh  +++|          MX3    1
00156  M00S00154.bldabh  +++|          SB5    B3+B4       (B5) = SHIFT COUNT TO POSITION MASK
00157  M00S00155.bldabh  +++|          AX3    B4
00158  M00S00156.bldabh  +++|          SB5    B5+B1
00159  M00S00157.bldabh  +++|          LX3    B5          POSITION MASK
00160  M00S00158.bldabh  +++|          SA2    A2+B1       READ ADDRESS OF VALUE PARAMETER
00161  M00S00159.bldabh  +++|          BX6    X0*X3
00162  M00S00160.bldabh  +++|          AX6    B3
00163  M00S00161.bldabh  +++|          ZR     X2,GAH5     IF NO LOCATION FOR KEYWORD
00164  M00S00162.bldabh  +++|          PX6    X6
00165  M00S00163.bldabh  +++|          SA6    X2
00166  M00S00164.bldabh  +++|          SA2    A2+B1       READ ADDRESS OF KEYWORD PARAMETER
00167  M00S00165.bldabh  +++|          SA1    X2          READ NEXT KEYWORD
00168  M00S00166.bldabh  +++|          NZ     X2,GAH4     IF SHOULD CONTINUE PROCESSING
00169  M00S00167.bldabh  +++|          EQ     GAH2        RESTORE (A0) AND RETURN
00170  M00S00168.bldabh  +++|
00171  M00S00169.bldabh  +++|*         ABORT TASK DUE TO ARGUMENT ERRORS.
00172  M00S00170.bldabh  +++|
00173  M00S00171.bldabh  +++| GAH5     SA1    GETABH
00174  M00S00172.bldabh  +++|          MX0    30
00175  M00S00173.bldabh  +++|          LX1    30
00176  M00S00174.bldabh  +++|          SA2    X1-1        READ *RJ* FROM CALLING PROGRAM
00177  M00S00175.bldabh  +++|          BX6    -X0*X2      SET TRACE-BACK WORD INTO BUFFER
00178  M00S00176.bldabh  +++|          SA6    BLDB
00179  M00S00177.bldabh  +++|          ARGERR  A6         EXIT TO EXECUTIVE
00180  M00S00178.bldabh  +++|
00181  M00S00179.bldabh  +++|          SPACE  4,10
00182  M00S00180.bldabh  +++|**        FKA - FIND KEYWORD ARGUMENT.
00183  M00S00181.bldabh  +++|*
00184  M00S00182.bldabh  +++|*         FIND KEYWORD ARGUMENT FINDS A KEYWORD PARAMETER AND RETURNS
00185  M00S00183.bldabh  +++|*         A FIELD WIDTH AND SHIFT COUNT WITH WHICH TO FORM A MASK IN
00186  M00S00184.bldabh  +++|*         THE APPROPRIATE FIELD OF THE *ABH*.
00187  M00S00185.bldabh  +++|*
00188  M00S00186.bldabh  +++|*         ENTRY  (X1) = KEYWORD TO BE FOUND - LEFT JUSTIFIED.
00189  M00S00187.bldabh  +++|*
00190  M00S00188.bldabh  +++|*         EXIT   (B3) = SHIFT COUNT FOR A MASK RIGHT JUSTIFIED.
00191  M00S00189.bldabh  +++|*                (B4) = FIELD WIDTH FOR MASK OF KEYWORD.
00192  M00S00190.bldabh  +++|*                (X6) = NON-ZERO - IF ARGUMENT NOT FOUND.
00193  M00S00191.bldabh  +++|*
00194  M00S00192.bldabh  +++|*         USES   X - 3, 4, 5, 6, 7.
00195  M00S00193.bldabh  +++|*                B - 3, 4.
00196  M00S00194.bldabh  +++|*                A - 3.
00197  M00S00195.bldabh  +++|
00198  M00S00196.bldabh  +++|
00199  M00S00197.bldabh  +++| FKA      SUBR               ENTRY/EXIT
00200  M00S00198.bldabh  +++|          MX4    18
00201  M00S00199.bldabh  +++|          SB3    TABHL
00202  M00S00200.bldabh  +++|          MX7    -6
00203  M00S00201.bldabh  +++| FKA1     SA3    TABH-1+B3   CURRENT ENTRY
00204  M00S00202.bldabh  +++|          BX5    X4*X3
00205  M00S00203.bldabh  +++|          SB3    B3-B1
00206  M00S00204.bldabh  +++|          BX6    X5-X1
00207  M00S00205.bldabh  +++|          ZR     X6,FKA2     IF KEY WORD FOUND
00208  M00S00206.bldabh  +++|          GE     B3,FKA1     IF TABLE NOT EXHAUSTED
00209  M00S00207.bldabh  +++|          EQ     FKAX        RETURN - ARGUMENT NOT VALID KEYWORD
00210  M00S00208.bldabh  +++|
00211  M00S00209.bldabh  +++| FKA2     BX4    -X7*X3
00212  M00S00210.bldabh  +++|          AX3    6
00213  M00S00211.bldabh  +++|          SB3    X4          (B3) = SHIFT COUNT
00214  M00S00212.bldabh  +++|          BX4    -X7*X3
00215  M00S00213.bldabh  +++|          SB4    X4          (B4) = FIELD WIDTH OF KEYWORD
00216  M00S00214.bldabh  +++|          EQ     FKAX        RETURN
00217  M00S00215.bldabh  +++|          SPACE  4,10
00218  M00S00216.bldabh  +++| BLDA     BSS    1           TEMPORARY STORAGE FOR (A0)
00219  M00S00217.bldabh  +++| BLDB     BSS    3           PARAMETER BLOCK FOR *CTI* REQUEST
00220  M00S00218.bldabh  +++|          SPACE  4
00221  M00S00219.bldabh  +++|**        TABH - TABLE OF KEYWORD PARAMETERS.
00222  M00S00220.bldabh  +++|*
00223  M00S00221.bldabh  +++|*T        18/KEYWORD, 30/0, 6/MASK, 6/BIT

Figure

00224  M00S00222.bldabh  +++|*
00225  M00S00223.bldabh  +++|*         WHERE - MASK = MASK WIDTH-1.
00226  M00S00224.bldabh  +++|*
00227  M00S00225.bldabh  +++|*                 BIT = BEGINNING BIT POSITION OF FIELD.
00228  M00S00226.bldabh  +++|
00229  M00S00227.bldabh  +++| TABH     BSS    0
00230  M00S00228.bldabh  +++|          VFD    18/3LABT,30/0,6/AHBTN-1,6/AHBTS-AHBTN+1
00231  M00S00229.bldabh  +++|          VFD    18/3LADR,30/0,6/AHADN-1,6/AHADS-AHADN+1
00232  M00S00230.bldabh  +++|          VFD    18/3LABN,30/0,6/AHBNN-1,6/AHBNS-AHBNN+1
00233  M00S00231.bldabh  +++|          VFD    18/3LACT,30/0,6/AHCTN-1,6/AHCTS-AHCTN+1
00234  M00S00232.bldabh  +++|          VFD    18/3LIBU,30/0,6/AHBUN-1,6/AHBUS-AHBUN+1
00235  M00S00233.bldabh  +++|          VFD    18/3LRFE,30/0,6/AHRFN-1,6/AHRFS-AHRFN+1
00236  M00S00234.bldabh  +++|          VFD    18/3LNFE,30/0,6/AHNFN-1,6/AHNFS-AHNFN+1
00237  M00S00235.bldabh  +++|          VFD    18/3LXPT,30/0,6/AHPTN-1,6/AHPTS-AHPTN+1
00238  M00S00236.bldabh  +++|          VFD    18/3LCAN,30/0,6/AHCNN-1,6/AHCNS-AHCNN+1
00239  M00S00237.bldabh  +++|          VFD    18/3LBIT,30/0,6/AHPRN-1,6/AHPRS-AHPRN+1
00240  M00S00238.bldabh  +++|          VFD    18/3LAIM,30/0,6/AHPRN-1,6/AHPRS-AHPRN+1
00241  M00S00239.bldabh  +++|          VFD    18/3LPEF,30/0,6/AHPRN-1,6/AHPRS-AHPRN+1
00242  M00S00240.bldabh  +++|          VFD    18/3LTLC,30/0,6/AHLCN-1,6/AHLCS-AHLCN+1
00243  M00S00241.bldabh  +++| TABHL    EQU    *-TABH      LENGTH OF KEYWORD PARAMETER TABLE
00244  M00S00242.bldabh  +++|          SPACE  4
00245  M00S00243.bldabh  +++|*         COMMON DECKS.
00246  M00S00244.bldabh  +++|
00247  M00S00245.bldabh  +++|
00248  M00S00246.bldabh  +++|*CALL     COMKZFN
00249  M00S00247.bldabh  +++|          SPACE  4
00250  M00S00248.bldabh  +++|          END