2 Modifications

Seq #  *Modification Id* Act 
----------------------------+
00001  M01S00001.bldabh  +++|          IDENT  BLDABH
00002  M01S00002.bldabh  +++|          ENTRY  BLDABH
00003  M01S00003.bldabh  +++|          ENTRY  GETABH

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

Seq #  *Modification Id* Act 
----------------------------+
00006  M02S00005.281l803 ---|          COMMENT COPYRIGHT CONTROL DATA CORP.  1978.
00007  M01S00001.281l803 +++|          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
00008  M01S00006.bldabh  +++|          TITLE  BLDABH - BUILD APPLICATION BLOCK HEADER.
00009  M01S00007.bldabh  +++|          SPACE  4
00010  M01S00008.bldabh  +++|*****     BLDABH - BUILD APPLICATION BLOCK HEADER.
00011  M01S00009.bldabh  +++|*         W.E. MARTIN.       77/01/31.
00012  M01S00010.bldabh  +++|
00013  M01S00011.bldabh  +++|
00014  M01S00012.bldabh  +++|*         COMMON TEXT DEFINITION.
00015  M01S00013.bldabh  +++|
00016  M01S00014.bldabh  +++|
00017  M01S00015.bldabh  +++|*CALL     COMCMAC
00018  M01S00016.bldabh  +++|*CALL     COMKFLD
00019  M01S00017.bldabh  +++|*CALL     COMKMAC
00020  M01S00018.bldabh  +++|*CALL     COMKNWF
00021  M01S00019.bldabh  +++|*CALL     COMSPRD
00022  M01S00020.bldabh  +++| BLDABH   SPACE  4,35
00023  M01S00021.bldabh  +++|***       BLDABH - BUILD APPLICATION BLOCK HEADER.
00024  M01S00022.bldabh  +++|*
00025  M01S00023.bldabh  +++|*         *BLDABH* WILL FORMAT THE APPLICATION BLOCK HEADER, *ABH*,
00026  M01S00024.bldabh  +++|*         FOR A FORTRAN EXTENDED OR COBOL USER.  SINCE THE HEADER
00027  M01S00025.bldabh  +++|*         IS PACKED INTO FIELDS THAT ARE MEANINGFUL ONLY TO THE
00028  M01S00026.bldabh  +++|*         SUPERVISORY MESSAGE PROCESSOR, THIS ROUTINE WILL MAP USER
00029  M01S00027.bldabh  +++|*         SUPPLIED (KEYWORD,VALUE) PAIRS INTO THE APPROPRIATE FIELDS
00030  M01S00028.bldabh  +++|*         VIA TABLE LOOKUP OF THE KEYWORD.
00031  M01S00029.bldabh  +++|*
00032  M01S00030.bldabh  +++|*         CALL FORMAT -
00033  M01S00031.bldabh  +++|*
00034  M01S00032.bldabh  +++|*         FORTRAN EXTENDED -
00035  M01S00033.bldabh  +++|*
00036  M01S00034.bldabh  +++|*         CALL BLDABH(KEYWORD1,VALUE1, ... )
00037  M01S00035.bldabh  +++|*
00038  M01S00036.bldabh  +++|*         COBOL -
00039  M01S00037.bldabh  +++|*
00040  M01S00038.bldabh  +++|*         ENTER BLDABH USING KEYWORD1,VALUE1, ... .
00041  M01S00039.bldabh  +++|*
00042  M01S00040.bldabh  +++|*         WHERE - KEYWORD1 = MAY BE OF THE FORM 3CXXX, WHERE C IS THE
00043  M01S00041.bldabh  +++|*                            HOLLERITH CHARACTER DESCRIPTOR, L OR H,
00044  M01S00042.bldabh  +++|*                            AND XXX IS ANY OF THE KEYWORDS WHOSE
00045  M01S00043.bldabh  +++|*                            UNION DETERMINES THE SET OF FIELDS IN THE
00046  M01S00044.bldabh  +++|*                            *ABH*.
00047  M01S00045.bldabh  +++|*
00048  M01S00046.bldabh  +++|*                 VALUE1 = VALUE TO BE ASSOCIATED WITH PRECEDING
00049  M01S00047.bldabh  +++|*                          KEYWORD.
00050  M01S00048.bldabh  +++|*                          FORTRAN EXTENDED = INTEGER.
00051  M01S00049.bldabh  +++|*                          COBOL = COMPUTATIONAL-1.
00052  M01S00050.bldabh  +++|
00053  M01S00051.bldabh  +++|
00054  M01S00052.bldabh  +++|          VFD    42/0LBLDABH,18/BLDABH
00055  M01S00053.bldabh  +++| BLDABH   SUBR               ENTRY/EXIT
00056  M01S00054.bldabh  +++|          SX6    A0
00057  M01S00055.bldabh  +++|          SB1    1
00058  M01S00056.bldabh  +++|          SA2    A1          READ TERMINAL NAME
00059  M01S00057.bldabh  +++|          SA6    BLDA        SAVE (A0)
00060  M01S00058.bldabh  +++|          SA3    =XABH.      DEFAULT APPLICATION BLOCK HEADER
00061  M01S00059.bldabh  +++|          ZR     X1,BLD2     IF NO ARGUMENTS - ABORT TASK
00062  M01S00060.bldabh  +++|          BX0    X3
00063  M01S00061.bldabh  +++|          SA1    X2
00064  M01S00062.bldabh  +++|
00065  M01S00063.bldabh  +++|*         PROCESS (KEYWORD,VALUE) PAIRS.
00066  M01S00064.bldabh  +++|
00067  M01S00065.bldabh  +++| BLD1     RJ     ZFN         ZERO FILL NAME
00068  M01S00066.bldabh  +++|          RJ     FKA         FIND KEYWORD ARGUMENT
00069  M01S00067.bldabh  +++|          NZ     X6,BLD2     IF KEYWORD NOT FOUND
00070  M01S00068.bldabh  +++|          MX1    1
00071  M01S00069.bldabh  +++|          SB5    B3+B4
00072  M01S00070.bldabh  +++|          AX1    B4          FORM MASK
00073  M01S00071.bldabh  +++|          SB5    B5+B1       INCREMENT SHIFT COUNT
00074  M01S00072.bldabh  +++|          SA2    A2+B1       READ VALUE FIELD
00075  M01S00073.bldabh  +++|          LX1    B5
00076  M01S00074.bldabh  +++|          ZR     X2,BLD2     IF PREMATURE END OF ARGUMENT LIST
00077  M01S00075.bldabh  +++|          SA3    X2
00078  M01S00076.bldabh  +++|          BX0    -X1*X0
00079  M01S00077.bldabh  +++|          UX3    X3          UNPACK POSSIBLE COBOL ARGUMENT
00080  M01S00078.bldabh  +++|          LX3    B3
00081  M01S00079.bldabh  +++|          BX0    X0+X3       MERGE VALUE
00082  M01S00080.bldabh  +++|          SA2    A2+B1
00083  M01S00081.bldabh  +++|          SA1    X2          NEXT KEYWORD
00084  M01S00082.bldabh  +++|          NZ     X2,BLD1     IF NOT END OF ARGUMENT LIST
00085  M01S00083.bldabh  +++|          BX6    X0
00086  M01S00084.bldabh  +++|          SA1    BLDA        SAVE (A0)
00087  M01S00085.bldabh  +++|          SA6    =XABH.
00088  M01S00086.bldabh  +++|          SA0    X1
00089  M01S00087.bldabh  +++|          EQ     BLDABHX     RETURN
00090  M01S00088.bldabh  +++|
00091  M01S00089.bldabh  +++|*         ABORT TASK DUE TO ARGUMENT ERROR.
00092  M01S00090.bldabh  +++|
00093  M01S00091.bldabh  +++| BLD2     SA1    BLDABH
00094  M01S00092.bldabh  +++|          MX0    30
00095  M01S00093.bldabh  +++|          LX1    30
00096  M01S00094.bldabh  +++|          SA2    X1-1        READ *RJ* FROM CALLING PROGRAM
00097  M01S00095.bldabh  +++|          BX6    -X0*X2      SET TRACE-BACK WORD INTO BUFFER
00098  M01S00096.bldabh  +++|          SA6    BLDB
00099  M01S00097.bldabh  +++|          ARGERR A6          EXIT TO EXECUTIVE
00100  M01S00098.bldabh  +++|
00101  M01S00099.bldabh  +++| GETABH   SPACE  4,10
00102  M01S00100.bldabh  +++|***       GETABH - GET APPLICATION BLOCK HEADER.
00103  M01S00101.bldabh  +++|*
00104  M01S00102.bldabh  +++|*         GET APPLICATION BLOCK HEADER MAKES A *CTI* REQUEST
00105  M01S00103.bldabh  +++|*         FOR RETURN OF THE LAST APPLICATION BLOCK HEADER THAT
00106  M01S00104.bldabh  +++|*         ACCOMPANIED A TERMINAL REQUEST.  THE KEYWORDS ARE
00107  M01S00105.bldabh  +++|*         LOOKED UP, THE APPROPRIATE FIELDS INTERROGATED AND
00108  M01S00106.bldabh  +++|*         RETURNED TO THE LOCATIONS SPECIFIED IN THE PARAMETER
00109  M01S00107.bldabh  +++|*         LIST.  IF THE TERMINAL IS LOGGED IN, THE STATUS WORD
00110  M01S00108.bldabh  +++|*         WILL BE RETURNED NON-ZERO; FURTHER, THE TASK WILL BE
00111  M01S00109.bldabh  +++|*         ABORTED IF THE REQUEST ATTEMPTS TO CROSS DATA BASES.
00112  M01S00110.bldabh  +++|*
00113  M01S00111.bldabh  +++|*         CALL FORMAT -
00114  M01S00112.bldabh  +++|*
00115  M01S00113.bldabh  +++|*         ALL CALLS ARE EXACTLY AS SPECIFIED IN *BLDABH*, WITH
00116  M01S00114.bldabh  +++|*         THE VALUES BEING RETURNED TO THE USER, INSTEAD OF
00117  M01S00115.bldabh  +++|*         BEING ACCEPTED.
00118  M01S00116.bldabh  +++|
00119  M01S00117.bldabh  +++|
00120  M01S00118.bldabh  +++|          VFD    42/0LGETABH,18/GETABH
00121  M01S00119.bldabh  +++| GETABH   SUBR               ENTRY/EXIT
00122  M01S00120.bldabh  +++|          MX0    42
00123  M01S00121.bldabh  +++|          SA2    X1          TERMINAL NAME
00124  M01S00122.bldabh  +++|          SB1    1
00125  M01S00123.bldabh  +++|          ZR     X1,GAH3     IF NO PARAMETERS
00126  M01S00124.bldabh  +++|          SX6    A0
00127  M01S00125.bldabh  +++|          UX1,B6 X2
00128  M01S00126.bldabh  +++|          SA6    BLDA
00129  M01S00127.bldabh  +++|          ZR     X1,GAH1     IF NO TERMINAL NAME
00130  M01S00128.bldabh  +++|          BX1    X0*X2
00131  M01S00129.bldabh  +++|          RJ     ZFN         ZERO FILL NAME
00132  M01S00130.bldabh  +++| GAH1     BX6    X1
00133  M01S00131.bldabh  +++|          SA3    A1+B1
00134  M01S00132.bldabh  +++|          SA6    BLDB
00135  M01S00133.bldabh  +++|          SX7    X3          (X7) = ADRESS OF STATUS PARAMETER
00136  M01S00134.bldabh  +++|          SX5    A1+         (X5) = ADDRESS OF PARAMETER LIST
00137  M01S00135.bldabh  +++|          SA7    A6+B1
00138  M01S00136.bldabh  +++|          GETABH A6
00139  M01S00137.bldabh  +++|          SA2    BLDB+2      APPLICATION BLOCK HEADER
00140  M01S00138.bldabh  +++|          BX0    X2          (X0) = ABH
00141  M01S00139.bldabh  +++|          SA2    BLDB+1      ADDRESS OF LOGGIN STATUS WORD
00142  M01S00140.bldabh  +++|          SA3    X2          (X3) = TERMINAL LOGIN STATUS
00143  M01S00141.bldabh  +++|          UX3    X3
00144  M01S00142.bldabh  +++|          NZ     X3,GAH3     IF TERMINAL LOGGED IN
00145  M01S00143.bldabh  +++| GAH2     SA1    BLDA
00146  M01S00144.bldabh  +++|          SA0    X1+
00147  M01S00145.bldabh  +++|          EQ     GETABHX     RETURN - TERMINAL NOT LOGGED IN
00148  M01S00146.bldabh  +++|
00149  M01S00147.bldabh  +++| GAH3     SA2    X5+2        READ ADDRESS OF KEYWORD
00150  M01S00148.bldabh  +++|          ZR     X2,GAH5     IF SHORT ARGUMENT LIST
00151  M01S00149.bldabh  +++|          SA1    X2+
00152  M01S00150.bldabh  +++| GAH4     RJ     ZFN         ZERO FILL NAME
00153  M01S00151.bldabh  +++|          RJ     FKA         FIND KEYWORD ARGUMENT
00154  M01S00152.bldabh  +++|          NZ     X6,GAH5     IF KEYWORD NOT FOUND
00155  M01S00153.bldabh  +++|          MX3    1
00156  M01S00154.bldabh  +++|          SB5    B3+B4       (B5) = SHIFT COUNT TO POSITION MASK
00157  M01S00155.bldabh  +++|          AX3    B4
00158  M01S00156.bldabh  +++|          SB5    B5+B1
00159  M01S00157.bldabh  +++|          LX3    B5          POSITION MASK
00160  M01S00158.bldabh  +++|          SA2    A2+B1       READ ADDRESS OF VALUE PARAMETER
00161  M01S00159.bldabh  +++|          BX6    X0*X3
00162  M01S00160.bldabh  +++|          AX6    B3
00163  M01S00161.bldabh  +++|          ZR     X2,GAH5     IF NO LOCATION FOR KEYWORD
00164  M01S00162.bldabh  +++|          PX6    X6
00165  M01S00163.bldabh  +++|          SA6    X2
00166  M01S00164.bldabh  +++|          SA2    A2+B1       READ ADDRESS OF KEYWORD PARAMETER
00167  M01S00165.bldabh  +++|          SA1    X2          READ NEXT KEYWORD
00168  M01S00166.bldabh  +++|          NZ     X2,GAH4     IF SHOULD CONTINUE PROCESSING
00169  M01S00167.bldabh  +++|          EQ     GAH2        RESTORE (A0) AND RETURN
00170  M01S00168.bldabh  +++|
00171  M01S00169.bldabh  +++|*         ABORT TASK DUE TO ARGUMENT ERRORS.
00172  M01S00170.bldabh  +++|
00173  M01S00171.bldabh  +++| GAH5     SA1    GETABH
00174  M01S00172.bldabh  +++|          MX0    30
00175  M01S00173.bldabh  +++|          LX1    30
00176  M01S00174.bldabh  +++|          SA2    X1-1        READ *RJ* FROM CALLING PROGRAM
00177  M01S00175.bldabh  +++|          BX6    -X0*X2      SET TRACE-BACK WORD INTO BUFFER
00178  M01S00176.bldabh  +++|          SA6    BLDB
00179  M01S00177.bldabh  +++|          ARGERR  A6         EXIT TO EXECUTIVE
00180  M01S00178.bldabh  +++|
00181  M01S00179.bldabh  +++|          SPACE  4,10
00182  M01S00180.bldabh  +++|**        FKA - FIND KEYWORD ARGUMENT.
00183  M01S00181.bldabh  +++|*
00184  M01S00182.bldabh  +++|*         FIND KEYWORD ARGUMENT FINDS A KEYWORD PARAMETER AND RETURNS
00185  M01S00183.bldabh  +++|*         A FIELD WIDTH AND SHIFT COUNT WITH WHICH TO FORM A MASK IN
00186  M01S00184.bldabh  +++|*         THE APPROPRIATE FIELD OF THE *ABH*.
00187  M01S00185.bldabh  +++|*
00188  M01S00186.bldabh  +++|*         ENTRY  (X1) = KEYWORD TO BE FOUND - LEFT JUSTIFIED.
00189  M01S00187.bldabh  +++|*
00190  M01S00188.bldabh  +++|*         EXIT   (B3) = SHIFT COUNT FOR A MASK RIGHT JUSTIFIED.
00191  M01S00189.bldabh  +++|*                (B4) = FIELD WIDTH FOR MASK OF KEYWORD.
00192  M01S00190.bldabh  +++|*                (X6) = NON-ZERO - IF ARGUMENT NOT FOUND.
00193  M01S00191.bldabh  +++|*
00194  M01S00192.bldabh  +++|*         USES   X - 3, 4, 5, 6, 7.
00195  M01S00193.bldabh  +++|*                B - 3, 4.
00196  M01S00194.bldabh  +++|*                A - 3.
00197  M01S00195.bldabh  +++|
00198  M01S00196.bldabh  +++|
00199  M01S00197.bldabh  +++| FKA      SUBR               ENTRY/EXIT
00200  M01S00198.bldabh  +++|          MX4    18
00201  M01S00199.bldabh  +++|          SB3    TABHL
00202  M01S00200.bldabh  +++|          MX7    -6
00203  M01S00201.bldabh  +++| FKA1     SA3    TABH-1+B3   CURRENT ENTRY
00204  M01S00202.bldabh  +++|          BX5    X4*X3
00205  M01S00203.bldabh  +++|          SB3    B3-B1
00206  M01S00204.bldabh  +++|          BX6    X5-X1
00207  M01S00205.bldabh  +++|          ZR     X6,FKA2     IF KEY WORD FOUND
00208  M01S00206.bldabh  +++|          GE     B3,FKA1     IF TABLE NOT EXHAUSTED
00209  M01S00207.bldabh  +++|          EQ     FKAX        RETURN - ARGUMENT NOT VALID KEYWORD
00210  M01S00208.bldabh  +++|
00211  M01S00209.bldabh  +++| FKA2     BX4    -X7*X3
00212  M01S00210.bldabh  +++|          AX3    6
00213  M01S00211.bldabh  +++|          SB3    X4          (B3) = SHIFT COUNT
00214  M01S00212.bldabh  +++|          BX4    -X7*X3
00215  M01S00213.bldabh  +++|          SB4    X4          (B4) = FIELD WIDTH OF KEYWORD
00216  M01S00214.bldabh  +++|          EQ     FKAX        RETURN
00217  M01S00215.bldabh  +++|          SPACE  4,10
00218  M01S00216.bldabh  +++| BLDA     BSS    1           TEMPORARY STORAGE FOR (A0)
00219  M01S00217.bldabh  +++| BLDB     BSS    3           PARAMETER BLOCK FOR *CTI* REQUEST
00220  M01S00218.bldabh  +++|          SPACE  4
00221  M01S00219.bldabh  +++|**        TABH - TABLE OF KEYWORD PARAMETERS.
00222  M01S00220.bldabh  +++|*
00223  M01S00221.bldabh  +++|*T        18/KEYWORD, 30/0, 6/MASK, 6/BIT

Figure

00224  M01S00222.bldabh  +++|*
00225  M01S00223.bldabh  +++|*         WHERE - MASK = MASK WIDTH-1.
00226  M01S00224.bldabh  +++|*
00227  M01S00225.bldabh  +++|*                 BIT = BEGINNING BIT POSITION OF FIELD.
00228  M01S00226.bldabh  +++|
00229  M01S00227.bldabh  +++| TABH     BSS    0
00230  M01S00228.bldabh  +++|          VFD    18/3LABT,30/0,6/AHBTN-1,6/AHBTS-AHBTN+1
00231  M01S00229.bldabh  +++|          VFD    18/3LADR,30/0,6/AHADN-1,6/AHADS-AHADN+1
00232  M01S00230.bldabh  +++|          VFD    18/3LABN,30/0,6/AHBNN-1,6/AHBNS-AHBNN+1
00233  M01S00231.bldabh  +++|          VFD    18/3LACT,30/0,6/AHCTN-1,6/AHCTS-AHCTN+1
00234  M01S00232.bldabh  +++|          VFD    18/3LIBU,30/0,6/AHBUN-1,6/AHBUS-AHBUN+1
00235  M01S00233.bldabh  +++|          VFD    18/3LRFE,30/0,6/AHRFN-1,6/AHRFS-AHRFN+1
00236  M01S00234.bldabh  +++|          VFD    18/3LNFE,30/0,6/AHNFN-1,6/AHNFS-AHNFN+1
00237  M01S00235.bldabh  +++|          VFD    18/3LXPT,30/0,6/AHPTN-1,6/AHPTS-AHPTN+1
00238  M01S00236.bldabh  +++|          VFD    18/3LCAN,30/0,6/AHCNN-1,6/AHCNS-AHCNN+1
00239  M01S00237.bldabh  +++|          VFD    18/3LBIT,30/0,6/AHPRN-1,6/AHPRS-AHPRN+1
00240  M01S00238.bldabh  +++|          VFD    18/3LAIM,30/0,6/AHPRN-1,6/AHPRS-AHPRN+1
00241  M01S00239.bldabh  +++|          VFD    18/3LPEF,30/0,6/AHPRN-1,6/AHPRS-AHPRN+1
00242  M01S00240.bldabh  +++|          VFD    18/3LTLC,30/0,6/AHLCN-1,6/AHLCS-AHLCN+1
00243  M01S00241.bldabh  +++| TABHL    EQU    *-TABH      LENGTH OF KEYWORD PARAMETER TABLE
00244  M01S00242.bldabh  +++|          SPACE  4
00245  M01S00243.bldabh  +++|*         COMMON DECKS.
00246  M01S00244.bldabh  +++|
00247  M01S00245.bldabh  +++|
00248  M01S00246.bldabh  +++|*CALL     COMKZFN
00249  M01S00247.bldabh  +++|          SPACE  4
00250  M01S00248.bldabh  +++|          END