Retro1.org codex

          IDENT  SEND
          ENTRY  SEND
          ENTRY  ABH.
          SYSCOM B1
          TITLE  SEND - SEND MESSAGE TO TERMINAL.
*COMMENT  SEND - SEND MESSAGE TO TERMINAL.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
*****     SEND - SEND MESSAGE TO TERMINAL.
*         W.E. MARTIN.       78/01/20.
          SPACE  4,10
*         COMMON DECK.
*CALL     COMKMAC
*CALL     COMSNCD
*CALL     COMSPRD
          VFD    42/0LSEND,18/SEND
          SPACE  4,55
***       CALL FORMAT -
*
*
*         FORTRAN EXTENDED -
*
*         CALL SEND(MESSAGE,LENGTH,TERMINAL,CEASE,OUTPUT,BLOCK,STATUS)
*
*         COBOL -
*
*         ENTER SEND USING MESSAGE,TERMINAL,CEASE,OUTPUT,BLOCK,STATUS,
*                          LENGTH.
*
*         WHERE - MESSAGE= LOCATION OF MESSAGE.
*
*                 LENGTH = LENGTH OF MESSAGE EXPRESSED IN CHARACTERS.
*
*                 TERMINAL = TERMINAL NAME.  IF OMMITTED OR ZERO, SEND
*                            TO TERMINAL THAT ORIGINATED TRANSACTION.
*                            ONE TO SEVEN CHARACTERS, LEFT JUSTIFIED.
*
*                 CEASE = FLAG WHOSE NON-ZERO VALUE IMPLIES TASK IS
*                         COMPLETE AT TERMINATION OF SEND.  ZERO IS
*                         ASSUMED.
*
*                 OUTPUT = 0 IF THIS IS THE LAST SEND TO BE DONE
*                          FOR THIS TRANSACTION.  NON-ZERO IMPLIES THAT
*                          MORE SENDS WILL BE EXECUTED FROM THIS TASK.
*                          DEFAULT = 0 (OPTIONAL PARAMETER).
*
*                 BLOCK = OPTIONAL PARAMETER WHICH IF SPECIFIED
*                         TASK DESIRES NAM APPLICATION BLOCK NUMBER
*                         FOR RECOVERY PURPOSES.
*
*                 STATUS = FLAG TO INDICATE A SEND WITH RECALL.
*                          IF STATUS IS NON-ZERO,
*                          CONTROL IS NOT RETURNED TO THE TASK UNTIL
*                          THE NETWORK HAS ACKNOWLEDGED THE RECEIPT AND
*                          DISPOSITION OF THE BLOCK.  THE SUPERVISORY
*                          MESSAGE IS THEN CONVERTED TO A *TAF*
*                          MESSAGE NUMBER AND RETURNED TO (STATUS).
*
*                 PARAMETER FORMAT - NUMERIC DATA -
*                                    FORTRAN EXTENDED - INTEGER.
*                                    COBOL - COMPUTATIONAL-1.
*
*         NOTE - THE NETWORK REQUIRES THAT *EOL* CHARACTERS BE
*         CONSIDERED MORE AS LINE SEPARATORS THAN LINE TERMINATORS.
*         THE *EOL* MUST BE ACCOUNTED FOR IN THE *TLC* FOR THE BLOCK
*         BEING SENT, AND THIS MUST BE DONE AT THE TASK LEVEL PRIOR
*         TO ACTUALLY ISSUING THE *SEND* REQUEST.
 
 
 SEND     SUBR               ENTRY/EXIT
          SX6    A0          SAVE (A0)
          BX7    X7-X7       CLEAR COBOL CALL FLAG
          SA6    SENG
 
*         CLEAR STORAGE OF LOCAL VARIABLES.
 
          SB1    1
          SA7    SENH
          SX6    X1          CHECK COBOL CALL
          MX4    3           (X4) = COBOL ARGUMENT MASK
          SA7    SENF        STATUS
          SA6    SENJ
          SA7    SENK        OUTPUT FLAG
          SX7    A1          SAVE FWA OF PARAMETER LIST
          BX0    X1
          SA7    SENE
          SB6    B1          SET ZERO CHECK FLAG TO INTEGER
          BX7    X1-X6
          SA3    A1+B1       READ LENGTH OR ADDRESS OF TERMINAL NAME
          LX4    20-59
          ZR     X7,SEN1     IF NOT COBOL COMPUTATIONAL-1 ARGUMENT
 
*         DETERMINE COBOL MESSAGE LENGTH FROM PARAMETER.
 
          LX7    -36         GET MESSAGE LENGTH
          MX5    -12
          BX2    -X5*X7
          BX5    X4*X3       EXTRACT COBOL USAGE
          LX5    -18
          MX7    1           SET COBOL CALL FLAG
          SB6    X5-4        ZERO IF COMP-1 USAGE
          SA7    SENH
          BX7    X2          SAVE MESSAGE LENGTH
          SA7    SENI
 
*         PROCESS PARAMETERS.
 
 SEN1     RJ     DOL         DETERMINE OPTIONS FROM PARAMETER LIST
          SA7    SENB+1      STORE TERMINAL NAME
          BX3    X3+X4       INSERT ALTERNATE TERMINAL FLAG
          SB5    X5          (B5) = CEASE FLAG
          SA1    SENJ        RESTORE FWA OF MESSAGE
          SA2    SENI        RESTORE MESSAGE LENGTH
          RJ     FEL         FORCE END OF LINE
          SEND   SENB
 
*         RETURN STATUS TO TASK AND DETERMINE EXIT CONDITIONS.
 
          RJ     RST         RETURN STATUS TO TASK
          PL     X6,SENDX    IF NO ERROR - RETURN
 
*         ABORT TASK DUE TO FAULTY SUPERVISORY MESSAGE.
 
          SA1    SEND        READ TRACE-BACK WORD
          MX0    30
          LX1    30
          SA1    X1-1        SET TRACE-BACK WORD INTO BUFFER
          BX6    -X0*X1
          SA6    SENB
          ARGERR SENB        EXIT TO EXECUTIVE
 DOL      SPACE  4,25
**        DOL - DETERMINE OPTIONS FROM LIST.
*
*         DETERMINE OPTIONS FROM LIST PARSES THE PARAMETER LIST
*         OF THE USER TASK, DETERMINING WHAT OPTIONS THE USER
*         DESIRES.  EACH OPTION IS DETERMINED BY THE EXISTENCE OF
*         THE PARAMETER AND ONCE THE LIST IS TRUNCATED, ALL
*         OPTIONS WHICH LIE TO THE RIGHT OF THAT PARAMETER ARE
*         GIVEN DEFAULT VALUES.
*
*         ENTRY  (X2) = MESSAGE LENGTH.
*                (X3) = ADDRESS OF CURRENT PARAMETER.
*                (X7) = NON-ZERO IF COBOL CALL.
*                (A3) = ADDRESS OF CURRENT LIST PARAMETER.
*
*         EXIT   (X3) = OPTIONS ARE FLAGGED IN UPPER SIX BITS.
*                (X6) = ALTERNATE TERMINAL FLAG - IF PRESENT.
*                (X7) = ALTERNATE TERMINAL NAME - ZERO IF NONE.
*                (SENF) = ADDRESS OF LOCATION REQUESTING NETWORK STATUS.
*
*         USES   A - ALL.
*                B - 4, 7.
*                X - ALL.
*
*         CALLS  ZFN.
 
 
 DOL      SUBR               ENTRY/EXIT
          NZ     X7,DOL1     IF COBOL CALL
          SA2    X3          READ LENGTH
          SX6    X2          SAVE MESSAGE LENGTH
          SA3    A3+B1       READ ADDRESS OF TERMINAL NAME
          UX2    X2          ASSUME MIXED PARAMETERS
          SA6    SENI
 DOL1     BX5    X5-X5       ASSUME CEASE = 0
          SX4    B0
          ZR     X3,DOL5     IF NO TERMINAL NAME, CEASE FLAG, OUTPUT
          SA4    X3          READ TERMINAL NAME
          UX1,B4 X4          COBOL COMPUTATIONAL-1 ARGUMENT
          ZR     X1,DOL2     IF NO TERMINAL NAME
          MX0    42
          BX1    X0*X4
          RJ     ZFN         ZERO FILL NAME
 DOL2     BX4    X1          SAVE TERMINAL NAME
          SA3    A3+B1       READ CEASE FLAG PARAMETER
          ZR     X3,DOL5     IF NO CEASE FLAG AND OUTPUT FLAG
          SA5    X3          READ CEASE FLAG
          SA3    A3+B1       OUTPUT FLAG ADDRESS
          ZR     X3,DOL5     IF NO OUTPUT FLAG
          SB7    A3          SAVE ADDRESS OF CURRENT PARAMETER.
          MX7    1
          SA3    X3          OUTPUT FLAG
          UX3    X3
          ZR     X3,DOL3     IF LAST SEND
          MX3    1           (X3) = STAGING REGISTER FOR *SEND* OPTIONS
          LX3    57-59       OUTPUT FLAG
 DOL3     SA1    B7+B1       NAM APPLICATION BLOCK FLAG
          ZR     X1,DOL5     IF NO BLOCK FLAG
          LX7    56-59       SET *B* FIELD IN HEADER
          SX6    X1          SAVE BLOCK PARAMETER ADDRESS
          SA2    X6          READ BLOCK NUMBER
          SA6    SENK
          UX2    X2
          NZ     X2,DOL4     IF (BLOCK) .NE. ZERO
          BX3    X7+X3
 DOL4     SA1    A1+B1       READ STATUS PARAMETER
          SA2    X1
          ZR     X1,DOL5     IF STATUS NOT SPECIFIED
          UX2    X2
          ZR     X2,DOL4.1   IF (STATUS) .EQ. ZERO
          LX7    55-56       SET *R* FIELD IN HEADER
          BX3    X3+X7
          SX7    X1          SAVE STATUS PARAMETER ADDRESS
          SA7    SENF
 DOL4.1   SA2    SENH        COBOL CALL FLAG
          PL     X2,DOL5     IF NOT COBOL CALL
          SA1    A1+1        READ LENGTH PARAMETER
          ZR     X1,DOL5     IF PARAMETER NOT PRESENT
          SA1    X1          SAVE COBOL MESSAGE LENGTH
          UX6    X1
          SA6    SENI
 DOL5     BX7    X4
          MX4    1
          ZR     X7,DOL6     IF NO ALTERNATE TERMINAL DECLARED
          BX3    X4+X3       SET ALTERNATE TERMINAL FLAG
 DOL6     LX4    54-59       SET APPLICATION BLOCK HEADER FLAG
          BX3    X4+X3
          ZR     X5,DOLX     IF NOT CEASE, RETURN
          LX4    58-59-54+59
          BX3    X4+X3       SET CEASE BIT IN SEND PARAMETER BLOCK
          EQ     DOLX        RETURN
 FEL      SPACE  4,20
**        FEL - FORCE END OF LINE.
*
*         FORCE *EOL* FOR TELEX COMPATIBILITY.  THIS CODE SEGMENT
*         IS UNNECESSARY FOR *NAM* TELE-COMMUNICATIONS, SINCE THE
*         EXACT CHARACTER COUNT IS REQUIRED IN THE *ABH*, TO INCLUDE
*         THE UNIT SEPARATOR, WILL ACCOMPANY ALL *SEND* REQUESTS TO
*         THE NETWORK.
*
*         ENTRY  (X1) = FWA OF MESSAGE.
*                (X2) = USER DECLARED CHARACTER COUNT AFTER TRUNCATION.
*                (X3) = HEADER OF WORD ONE OF *SEND* PARAMETER BLOCK.
*
*         EXIT   (B3) = CHARACTERS IN LAST WORD OF MESSAGE.
*                (SENB - SENB+4) UPDATED.
*                (ABH) UPDATED BY (TLC).
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 3, 4, 7.
*                X - ALL.
 
 
 FEL      SUBR               ENTRY/EXIT
          SX5    X2+9        COMPUTE NUMBER OF WORDS IN MESSAGE
          SX4    10
          BX6    X1          INSERT MESSAGE ADDRESS
          IX5    X5/X4       NUMBER OF WORDS
          LX6    30          INSERT NUMBER OF WORDS INTO BLOCK HEADER
          BX7    X6+X5
          BX7    X7+X3       INSERT SEQUENCE, BLOCK FLAG
          SA7    SENB        STORE ARGUMENT WORD
          SA3    ABH.
          LX3    59-22
          PL     X3,FEL2     IF *ACT* .NE. *DISPLAY*
          SX3    10
          IX0    X3*X5
          IX0    X0-X2
          IX7    X3-X0
          IX5    X1+X5       (X5) = LAST WORD ADDRESS OF MESSAGE
          SA3    X5-1        SAVE LWA OF MESSAGE
          BX6    X3
          SB4    B0          (B4) = 0 WHEN (X7) = 0
          SA6    SENC
          SA2    A3+B1
          BX6    X2
          SA6    A6+B1
          SX6    A3
          SA6    SENL        LWA OF MESSAGE
          SA2    SENB
          ZR     X0,FEL1     IF LAST WORD IS FULL
 
*         REMOVE TRAILING CHARACTERS FROM LAST WORD.
 
          SB4    X7-9        (B4) = NUMBER OF CHARACTERS IN WORD
          SB3    X0          (B3) = NUMBER OF TRAILING CHARACTERS
          LX7    X0,B1       TRAILING CHARACTERS*2
          LX0    2           MULTIPLY BY 4
          IX7    X0+X7       NUMBER OF TRAILING BITS
          SB7    X7-59
          MX4    1
          LX4    X4,B7
          BX7    X4*X3       STRIP TRAILING CHARACTER FIELDS
          SA7    A3
          SA3    SENI        INCREMENT TLC TO INCLUDE UNIT SEPARATOR
          SX7    X3+B3
          SA7    A3
 FEL1     NZ     B4,FEL2     IF FEWER THAN NINE CHARACTERS
 
*         PROCESS CASE WHERE LAST WORD IS FULL - REQUIRING EXTRA WORD
*         FOR EOL.
 
          SA2    SENB
          SX6    B1
          IX6    X2+X6       INCREMENT WORD COUNT
          SA6    A2
          BX6    X6-X6
          SA6    X5+
          SA3    SENI        INCREMENT TLC TO INCLUDE UNIT SEPARATOR
          SB3    10
          SX6    X3+B3
          SA6    A3
 
*         CONSTRUCT ABH FOR *SEND*.
 
 FEL2     MX0    -12         (X0) = *ABN* AND *TLC* MASK
          BX7    X7-X7
          SA1    SENK        READ BLOCK PARAMETER ADDRESS
          SB3    B4          (B3) = NUMBER OF CHARACTERS IN LAST WORD
          SA3    ABH.        READ CURRENT *ABH*
          MX6    6
          ZR     X1,FEL3     IF NO BLOCK OR STATUS PARAMETERS PRESENT
          SA1    X1
          SX7    X1          APPLICATION BLOCK NUMBER
          ZR     X7,FEL3     IF NO BLOCK NUMBER
          LX0    41-11
          BX3    X0*X3       INSERT BLOCK NUMBER INTO *ABH*
          LX7    41-17
          LX0    11-41
 FEL3     BX7    X7+X3
          BX7    X0*X7       SET *TLC* INTO *ABH*
          BX7    -X6*X7      CLEAR APPLICATION BLOCK TYPE
          SX1    B1+B1       SET MSG ABT
          LX2    59-57
          PL     X2,FEL4     IF NO OUTPUT TO FOLLOW
          SX1    B1          SET *BLK* *BLK* ABT
 FEL4     LX1    59-5
          BX7    X1+X7       SET APPLICATION BLOCK TYPE
          SA2    SENI        SET TLC INTO ABH
          BX7    X7+X2
          SA7    SENB+2
          EQ     FELX        RETURN
 RST      SPACE  4,20
**        RST - RETURN STATUS TO TASK.
*
*         RETURN NETWORK SUPERVISORY MESSAGE TO TASK IF RECALL
*         PARAMETER WERE SPECIFIED.
*
*         ENTRY  (B5) .NE. ZERO IF CEASE REQUESTED.
*                (B3) = NUMBER OF CHARACTERS IN LAST WORD OF MESSAGE.
*                (X5) = ADDRESS OF TEMPORARY STORAGE LOCATION.
*
*         EXIT   (X6) .LT. 0 - IF ILLEGAL SUPERVISORY MESSAGE.
*                (BLOCK) RETURNED TO TASK IF (BLOCK) .NE. ZERO
*                UPON ENTRY TO *SEND*.
*                (STATUS) = TAF STATUS MESSAGE, DERIVED FROM (SENB+3).
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 3, 4.
*                X - 0, 1, 2, 3, 4, 6, 7.
 
 
 RST      SUBR               ENTRY/EXIT
          SB4    TSENL-1
          SA2    SENB
          LX2    59-56
          PL     X2,RST1     IF APPLICATION BLOCK NOT TO BE RETURNED
          MX0    12
          SA3    SENB+1      BLOCK NUMBER
          SA2    SENK        FWA OF BLOCK
          SX3    X3
          SA4    X2
          BX7    X0*X4       CLEAR OLD BLOCK NUMBER
          BX7    X7+X3       NEW BLOCK NUMBER
          SA7    A4+         RETURN BLOCK NUMBER
 RST1     SA1    SENF        READ STATUS REQUEST
          SX4    X1+
          ZR     X1,RST4     IF STATUS NOT REQUESTED
          SA1    SENM
          SA2    SENB+3      SUPERVISORY MESSAGE RETURNED FROM NETWORK
          BX0    X1*X2
 
*         DETERMINE SUPERVISORY MESSAGE VIA TABLE LOOK-UP.
 
 RST2     SA3    TSEN+B4     READ CURRENT TABLE ENTRY
          BX6    X1*X3
          IX6    X6-X0
          SB4    B4-B1
          ZR     X6,RST3     IF ENTRY AND MESSAGE MATCH
          MX6    1
          GE     B4,RST2     IF TABLE NOT EXHAUSTED
          EQ     RSTX        RETURN
 
 RST3     SX6    X3          RETURN MESSAGE NUMBER TO (STATUS)
          PX6    X6
          SA6    X4+
 RST4     SA3    ABH.        READ ABH
          SA1    SENC        RESTORE LAST WORD
          LX3    59-22
          PL     X3,RST5     IF NOT DISPLAY
          BX6    X1
          SA2    SENL        RESTORE LAST TWO WORDS
          SA6    X2
          SA1    A1+B1
          BX6    X1
          SA6    A6+B1
 RST5     SA1    SENG        RESTORE (A0)
          SA0    X1
          BX6    X6-X6       SET NON-ERROR CONDITION
          EQ     RSTX        RETURN
          SPACE  4,10
*         PROGRAM CONSTANTS AND TEMPORARY STORAGE.
 
 ABH.     VFD    6/2,12/0,18/0,4/4,1/0,3/0,1/1,3/0,12/0
 SENB     BSSZ   4           PARAMETER BLOCK FOR *SEND*
 SENC     BSSZ   4           ARGUMENT STORAGE FOR *SEND*
 SENE     CON    0           STORAGE FOR FWA OF CALL PARAMETERS
 SENF     CON    0           STORAGE FOR STATUS ADDRESS
 SENG     CON    0           STORAGE FOR (A0)
 SENH     CON    0           COBOL CALL FLAG
 SENI     CON    0           STORAGE FOR MESSAGE CHARACTER COUNT
 SENJ     CON    0           STORAGE FOR MESSAGE FWA
 SENK     CON    0           STORAGE FOR *BLOCK* PARAMETER ADDRESS
 SENL     CON    0           STORAGE FOR LWA MESSAGE
 
*         MASK FOR EXTRACTING SUPERVISORY MESSAGES.
 
 SENM     VFD    8/377B,1/0,1/0,6/77B,8/377B,36/0
          SPACE  4,10
*         TABLE OF SUPERVISORY MESSAGES.
 
 TSEN     BSS    0
          VFD    8/PFFC,1/0,1/0,6/SFAK,8/0,36/1
          VFD    8/PFFC,1/0,1/0,6/SFAX,8/AXLB,36/2
          VFD    8/PFCN,1/0,1/0,6/SFEN,8/0,36/10
          VFD    8/PFCN,1/0,1/0,6/SFCB,8/CBLF,36/11
 TSENL    EQU    *-TSEN      LENGTH ON MESSAGE TABLE
*         COMMON DECK.
*CALL     COMKZFN
          SPACE  4,10
          END