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