Retro1.org codex

          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