Trailing-Edge
-
PDP-10 Archives
-
BB-FB51A-RM
-
sna-ai/sources/saimac.b36
There are no other files named saimac.b36 in the archive.
%title 'SNA GATEWAY ACCESS MACRO-20 INTERFACE'
module SAIMAC (ident = 'Version 1.0') =
begin
! Copyright (c) 1985 by
! DIGITAL EQUIPMENT CORPORATION, Maynard, Massachusetts
!
! This software is furnished under a license and may be used and copied
! only in accordance with the terms of such license and with the
! inclusion of the above copyright notice. This software or any other
! copies thereof may not be provided or otherwise made available to any
! other person. No title to and ownership of the software is hereby
! transferred.
!
! The information in this software is subject to change without notice
! and should not be construed as a commitment by Digital Equipment
! Corporation.
!
! Digital assumes no responsibility for the use or reliability of its
! software on equipment which is not supplied by Digital.
!++
! FACILITY:
!
! SNA Gateway Access Module
!
! ABSTRACT:
!
! The following Macro calls are supported by this module:
!
! Call Function
! ____ ________
!
! A_ACC Accept a BIND
! A_CON Connect to an IBM application
! A_LIS Listen for an IBM BIND
! A_RDE Read Event Data
! A_RBD Read BIND Data
! A_RAD Read Abort Data
! A_REC Recieve a data message
! A_REM Recieve expedited message
! A_RCN Reconnect after a UNBIND type 2
! A_REJ Reject a connect
! A_TER Terminate port access
! A_TRA Transmit to an IBM application
!
! ENVIRONMENT:
!
! TOPS-20 Operating Systems, user interface.
!
! AUTHOR: Vicki Gary March 17, 1984
!
! MODIFIED BY:
!
! , : VERSION
! 01 -
!--
!
! TABLE OF CONTENTS
!
!
! INCLUDE FILES
!
library 'MONSYM'; ! Monitor symbols
library 'SNACOM'; ! SNA Gateway Access common symbols
require 'JSYS'; ! JSYS declarations
!
! MACROS
!
macro PORT_STATE (STATE) [ ] =
begin
selectone STATE of
set
[%remaining]: $TRUE;
[otherwise]: $FALSE;
tes
end %;
!
! FORWARD ROUTINE
!
forward routine
GAM$VERIFY_PORT,
GAM$SERVICE_PORT,
GAM$PORT_STATE,
GAM$ASCIZ: novalue,
GAM$ASCIC: novalue;
!
! EXTERNAL REFERENCES
!
external ! SNA Virtual Circuit Data Blocks
SNAVCB: PORT_CONTROL_BLOCKS,
SNAEIB: RING_BLOCK_VECTOR,
SNAEOB: RING_BLOCK_VECTOR,
SNAIOB: IO_BUFFER_BLOCKS;
external ! Free virtual circuit ports and index
FREECI,
FREECP: STACK (MAXIMUM_SUPPORTED_PORTS*2);
external routine ! DECnet specific functions
GAD$ABORT_LINK,
GAD$ABORT_REASON,
GAD$DISCONNECT_LINK,
GAD$LINK_STATUS,
GAD$NETWORK_DESCRIPTOR,
GAD$OPEN_LINK,
GAD$OPEN_SERVER,
GAD$PROTOCOL_TYPE,
GAD$PSI_CHANNELS,
GAD$RECEIVE_DATA,
GAD$RECEIVE_INTERRUPT,
GAD$SEND_DATA,
GAD$SEND_INTERRUPT,
GAD$EC_SEND_DATA;
external routine ! DECnet logical link function
GAL$TERMINATE,
GAL$INTERRUPT,
GAL$REJECT,
GAL$LINK_SERVICE: novalue;
external routine ! Protocol building routines
GAP$O_ACCEPT,
GAP$O_CALL,
GAP$O_RECONNECT,
GAP$O_LISTEN,
GAP$O_FLUSH,
GAP$O_DATA;
%global_routine ('A_ACC', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%ACC Accept Incoming BIND
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
LENGTH,
RCODE,
PORT: ref PORT_CONTROL_BLOCK,
DATA_BASE: ref USER_DATA_BASE;
! Verify for legal port number and port data base
if (PORT = GAM$VERIFY_PORT (.ARGBLK[ACC_PORT_NUMBER], AF_ACC)) neq 0
then DATA_BASE = .PORT[PCB_DATA_BASE] ! Get user data base
else begin ! Failed to locate port control block
ARGBLK[ACC_RETURN_CODE] = AC_BPN;
return;
end;
ARGBLK[ACC_RETURN_CODE] = 0; ! Initialize return code
! Build protocol message
GAP$O_ACCEPT (.ARGBLK, .PORT[PCB_OUTPUT_BUFFER], LENGTH);
! Send protocol message to the Gateway node
if not GAD$SEND_DATA (.PORT[PCB_JFN], ch$ptr (.PORT[PCB_OUTPUT_BUFFER],,8), .LENGTH)
then begin
ARGBLK[ACC_RETURN_CODE] = .ARGBLK[ACC_RETURN_CODE] or AC_SER;
return;
end;
PORT[PCB_STATE] = AS_RUN; ! Update port state
ARGBLK[ACC_RETURN_CODE] = AC_SUC;
GAP$O_FLUSH (.PORT[PCB_OUTPUT_BUFFER]);
while .DATA_BASE[UDB_FLUSH_SEND] gtr 0 do
begin
local PTR;
DATA_BASE[UDB_FLUSH_SEND] = .DATA_BASE[UDB_FLUSH_SEND] - 1;
! Send flush messages to the Gateway node
PTR = ch$ptr (.PORT[PCB_OUTPUT_BUFFER],,8);
if not GAD$SEND_DATA (.PORT[PCB_JFN], .PTR, 2)
then begin
ARGBLK[ACC_RETURN_CODE] = .ARGBLK[ACC_RETURN_CODE] or AC_SER;
end;
end;
return;
end; ! End of A_ACC
%global_routine ('A_REJ', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%REJ REJECT the BIND request
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
PTR,
LENGTH,
PORT: ref PORT_CONTROL_BLOCK,
DATA_BASE: ref USER_DATA_BASE;
! Verify for legal port number and port data base
if (PORT = GAM$VERIFY_PORT (.ARGBLK[REJ_PORT_NUMBER], AF_REJ)) neq 0
then DATA_BASE = .PORT[PCB_DATA_BASE] ! Get user data base address
else begin ! Failed to get port control block
ARGBLK[REJ_RETURN_CODE] = AC_BPN;
return;
end;
ARGBLK[REJ_RETURN_CODE] = 0; ! Initialize return code
PORT[PCB_STATE] = AS_ABG;
! Assemble protocol message
GAL$REJECT (.PORT[PCB_JFN], .ARGBLK[REJ_SENSE_CODE], AR_URJ);
PORT[PCB_STATE] = AS_ABD;
! Erase port data base
FREECI = .FREECI - 1;
FREECP[.FREECI] = .ARGBLK[REJ_PORT_NUMBER];
return;
end; ! End of A_REJ
%global_routine ('A_CON', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%CON Connect to an IBM application
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
DESCRIPTOR: CH$SEQUENCE (80),
SNABUF: CH$SEQUENCE (280, 8);
local
JFN,
PTR,
POINTER,
STATUS,
SYSERR,
LENGTH,
OBJECT,
PORT: ref PORT_CONTROL_BLOCK,
DATA_BASE: ref USER_DATA_BASE;
if .FREECI geq MAXIMUM_SUPPORTED_PORTS
then begin ! Run out of ports to allocate
ARGBLK[CON_RETURN_CODE] = AC_IAR;
return;
end;
DATA_BASE = .ARGBLK[WORKING_AREA]; ! Get port data base
! Get the target task name
POINTER = ch$ptr (DESCRIPTOR);
OBJECT = ch$ptr (uplit ('-10'));
STATUS = GAD$NETWORK_DESCRIPTOR (.POINTER, .ARGBLK[CON_NODE_NAME], .OBJECT);
if .STATUS neq $TRUE
then begin ! Failed to build the DCN: filespec
ARGBLK[CON_RETURN_CODE] = (selectone .STATUS of
set
[-1]: AC_NLN;
[otherwise]: AC_PER;
tes);
return;
end;
STATUS = GAD$OPEN_LINK (.POINTER, JFN, SYSERR);
if .STATUS neq $TRUE
then begin ! Failed to connect to the Gateway
ARGBLK[CON_RETURN_CODE] = (selectone .STATUS of
set
[-1]: AC_DCE;
[-2]: AC_DLA;
[otherwise]: AC_PER;
tes);
ARGBLK[CON_NODE_NAME] = .SYSERR;
return;
end;
! Assemble protocol message
GAP$O_CALL (.ARGBLK, SNABUF, LENGTH);
! Return error if data truncated
if .(ARGBLK[CON_RETURN_CODE])<$(AC_DFT)> ! Data field truncated
then return;
! Send OUTGOING CALL message to Gateway node
if not GAD$EC_SEND_DATA (.JFN, ch$ptr (SNABUF,,8), .LENGTH, SYSERR)
then begin
GAD$ABORT_LINK (.JFN);
ARGBLK[CON_RETURN_CODE] = .ARGBLK[CON_RETURN_CODE] or AC_DCE;
ARGBLK[CON_NODE_NAME] = .SYSERR;
end
else begin
local
INTERRUPT_CHANNEL,
PORT_NUMBER,
LEN,
RING0,
RING: ref RING_BLOCK,
ENTRY: ref RING_ENTRY,
PTR;
INTERRUPT_CHANNEL = .ARGBLK[CON_INTERRUPT_CHANNEL];
ARGBLK[CON_PORT_NUMBER] = PORT_NUMBER = .FREECP[.FREECI];
FREECI = .FREECI + 1; ! Push down on stack
PORT = SNAVCB[.PORT_NUMBER,PCB_BLOCK_FIELD]; ! Get control block
XERO (.PORT, PORT_CONTROL_BLOCK_SIZE);
PORT[PCB_JFN] = .JFN; ! Save DECnet logical link JFN
PORT[PCB_STATE] = AS_BNW; ! Set port state to BINDWAIT
PORT[PCB_ERROR] = 0; ! No error
PORT[PCB_RCV_INTERRUPT] = $FALSE;
PORT[PCB_PACKET_SIZE] = 0;
PORT[PCB_RESET_SEEN] = 0; ! No reset seen yet
PORT[PCB_INTCNT] = 0;
PORT[PCB_DATA_BASE] = .DATA_BASE; ! Save user data base address
PORT[PCB_INPUT_BUFFER] = SNAIOB[.PORT_NUMBER,IOB_INPUT_BUFFER];
PORT[PCB_OUTPUT_BUFFER] = SNAIOB[.PORT_NUMBER,IOB_OUTPUT_BUFFER];
RING = SNAEIB[.PORT_NUMBER];
XERO (.RING, RING_SIZE);
incr I from 0 to MAX_INTERRUPTS - 2 do
begin
ENTRY = RING[.I];
ENTRY[NEXT_RING_PTR] = RING[.I+1];
ENTRY = RING[.I+1];
end;
RING0 = ENTRY[NEXT_RING_PTR] = RING[0];
PORT[PCB_INHEAD_BUFFER] = .RING0;
PORT[PCB_INTAIL_BUFFER] = .RING0;
RING = SNAEOB[.PORT_NUMBER];
XERO (.RING, RING_SIZE);
incr I from 0 to MAX_INTERRUPTS - 2 do
begin
ENTRY = RING[.I];
ENTRY[NEXT_RING_PTR] = RING[.I+1];
ENTRY = RING[.I+1];
end;
RING0 = ENTRY[NEXT_RING_PTR] = RING[0];
PORT[PCB_OUTHEAD_BUFFER] = .RING0;
PORT[PCB_OUTTAIL_BUFFER] = .RING0;
GAM$ASCIC (.ARGBLK[CON_USER_DATA_LENGTH], ! Save call data
ch$ptr (.ARGBLK[CON_USER_DATA],,8),
ch$ptr (DATA_BASE[UDB_USER_DATA],,8));
if GAD$PSI_CHANNELS (.JFN, .INTERRUPT_CHANNEL)
then ARGBLK[CON_RETURN_CODE] = AC_SUC
else begin ! Failed to set up PSI channel
GAD$ABORT_LINK (.JFN);
ARGBLK[CON_RETURN_CODE] = .ARGBLK[CON_RETURN_CODE] or AC_PER;
return;
end;
if .PORT[PCB_PACKET_SIZE] leq 0
then PORT[PCB_PACKET_SIZE] = 1 ^ AF_STANDARD_PACKET_SIZE;
end;
return;
end; ! End of A_CON
%global_routine ('A_REC', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%REC Recieve data message
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
POINTER,
LENGTH,
RCODE,
PORT: ref PORT_CONTROL_BLOCK,
DATA_BASE: ref USER_DATA_BASE;
! Verify for legal port number and port data base, then get user
! data base address
if (PORT = GAM$SERVICE_PORT (.ARGBLK[REC_PORT_NUMBER], AF_REC)) neq 0
then DATA_BASE = .PORT[PCB_DATA_BASE]
else begin ! Failed to get port control block
ARGBLK[REC_RETURN_CODE] = AC_BPN;
return; ! Return procedure error
end;
! Check for data availability
if not .DATA_BASE[UDB_DATA_AVAILABLE]
then begin
ARGBLK[REC_DATA_LENGTH] = 0;
ARGBLK[REC_RETURN_CODE] = (if .PORT[PCB_RESET_SEEN] lss 0 ! No data
then AC_RCN ! because reconnect pending
else AC_NDA); ! because none came in
return;
end;
if .PORT[PCB_STATE] eql AS_FLU ! No data
then begin
ARGBLK[REC_RETURN_CODE] = AC_NDA; ! because FLUSH came in
XERO (.DATA_BASE[UDB_USER_DATA], .DATA_BASE[UDB_DATA_LENGTH]);
DATA_BASE[UDB_DATA_AVAILABLE] = $FALSE;
DATA_BASE[UDB_DATA_LENGTH] = 0;
PORT[PCB_STATE] = AS_RUN;
return;
end;
! Pull off the sequence number and the RH and
! return them to the user
POINTER = ch$ptr (DATA_BASE[UDB_USER_DATA],,8);
ch$move (2, .POINTER, ch$ptr (ARGBLK[REC_SEQ_NUMBER],,8));
POINTER = ch$plus (.POINTER, 2);
ch$move (3, .POINTER, ch$ptr (ARGBLK[REC_RH],,8));
POINTER = ch$plus (.POINTER, 3);
DATA_BASE[UDB_DATA_LENGTH] = .DATA_BASE[UDB_DATA_LENGTH] - 5;
if (.ARGBLK[REC_DATA_LENGTH] leq 0) ! Null receiving buffer
and (.DATA_BASE[UDB_DATA_LENGTH] gtr 0)
then ARGBLK[REC_RETURN_CODE] = AC_DFT
else begin
! The received data is larger than the receiving buffer
if .DATA_BASE[UDB_DATA_LENGTH] gtr .ARGBLK[REC_DATA_LENGTH]
then ARGBLK[REC_RETURN_CODE] = AC_DFT
else ARGBLK[REC_DATA_LENGTH] = .DATA_BASE[UDB_DATA_LENGTH];
! THIS SECTION IS NON-TRANSPORTABLE BLISS CODE.
! Reason: the JSYS is used instead of regular BLISS ch$wchar function
! due to the posibility that the receiving data pointer might be a
! file JFN, and the SOUT JSYS will update that upon return.
jsys_sout (.ARGBLK[REC_DATA_POINTER],
.POINTER, -.ARGBLK[REC_DATA_LENGTH];
ARGBLK[REC_DATA_POINTER]);
end;
! Remove data from buffer and reset buffer counter
ch$fill (0, .DATA_BASE[UDB_DATA_LENGTH], .POINTER);
DATA_BASE[UDB_DATA_AVAILABLE] = $FALSE;
DATA_BASE[UDB_DATA_LENGTH] = 0;
return;
end; ! End of A_REC
%global_routine ('A_REM', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%REM Receive Expedited Message
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
POINTER,
TAIL: ref RING_ENTRY,
PORT: ref PORT_CONTROL_BLOCK,
DATA_BASE: ref USER_DATA_BASE;
! Verify for legal port number and port data base
if (PORT = GAM$SERVICE_PORT (.ARGBLK[REM_PORT_NUMBER], AF_REM)) neq 0
then DATA_BASE = .PORT[PCB_DATA_BASE] ! Get user data base address
else begin ! Failed to get port control block
ARGBLK[REM_RETURN_CODE] = AC_BPN;
return;
end;
! Check for data availability
if not .DATA_BASE[UDB_INTERRUPT_AVAILABLE]
then begin
ARGBLK[REM_DATA_LENGTH] = 0;
ARGBLK[REM_RETURN_CODE] = (if .PORT[PCB_RESET_SEEN] lss 0 ! No data
then AC_RCN ! because reconnect pending
else AC_NDA); ! because none came in
return;
end;
TAIL = .PORT[PCB_INTAIL_BUFFER];
if .TAIL[IN_USE_FLAG] eql 0
then begin
ARGBLK[REM_RETURN_CODE] = AC_NDA;
return;
end;
! Pull off the sequence number and the RH and
! return them to the user
POINTER = ch$ptr (TAIL[DATA_BUFFER],,8);
ch$move (2, .POINTER, ch$ptr (ARGBLK[REM_SEQ_NUMBER],,8));
POINTER = ch$plus (.POINTER, 2);
ch$move (3, .POINTER, ch$ptr (ARGBLK[REM_RH],,8));
POINTER = ch$plus (.POINTER, 3);
TAIL[DATA_LENGTH] = .TAIL[DATA_LENGTH] - 5;
if (.ARGBLK[REM_DATA_LENGTH] leq 0) ! Null receiving buffer
and (.TAIL[DATA_LENGTH] gtr 0)
then ARGBLK[REM_RETURN_CODE] = AC_DFT
else begin
! The received data is larger than the receiving buffer
if .TAIL[DATA_LENGTH] gtr .ARGBLK[REM_DATA_LENGTH]
then ARGBLK[REM_RETURN_CODE] = AC_DFT !
else ARGBLK[REM_DATA_LENGTH] = .TAIL[DATA_LENGTH];
! THIS SECTION IS NON-TRANSPORTABLE BLISS CODE.
! Reason: the JSYS is used instead of regular BLISS ch$wchar function
! due to the posibility that the receiving data pointer might be a
! file JFN, and the SOUT JSYS will update that upon return.
jsys_sout (.ARGBLK[REM_DATA],
.POINTER, -.ARGBLK[REM_DATA_LENGTH];
ARGBLK[REM_DATA]);
end;
! Remove data from buffer and reset buffer counter
PORT[PCB_INTAIL_BUFFER] = .TAIL[NEXT_RING_PTR];
XERO (TAIL[DATA_BUFFER], INT_BUFFER_SIZE);
TAIL[IN_USE_FLAG] = 0;
PORT[PCB_INTCNT] = .PORT[PCB_INTCNT] - 1;
if .PORT[PCB_INTCNT] eql 0
then DATA_BASE[UDB_INTERRUPT_AVAILABLE] = $FALSE;
TAIL[DATA_LENGTH] = 0;
return;
end; ! End of A_REM
%global_routine ('A_RDE', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%RDE Read Event Data
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
PORT: ref PORT_CONTROL_BLOCK,
DATA_BASE: ref USER_DATA_BASE;
! Verify for legal port number and port data base
if (PORT = GAM$SERVICE_PORT (.ARGBLK[RDE_PORT_NUMBER], AF_RDE)) neq 0
then DATA_BASE = .PORT[PCB_DATA_BASE] ! Get user data base address
else begin ! Failed to get port control block
ARGBLK[RDE_STATE] = AS_UND;
ARGBLK[RDE_RETURN_CODE] = AC_BPN;
return;
end;
ARGBLK[RDE_STATE] = .PORT[PCB_STATE];
ARGBLK[RDE_ERROR] = .PORT[PCB_ERROR];
ARGBLK[RDE_DATA_AVAILABLE] = .DATA_BASE[UDB_DATA_AVAILABLE];
ARGBLK[RDE_INTERRUPT_AVAILABLE] = .DATA_BASE[UDB_INTERRUPT_AVAILABLE];
ARGBLK[RDE_RETURN_CODE] = AC_SUC;
return;
end; ! End of A_RDE
%global_routine ('A_RAD', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%RAD Read Abort Data
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
PORT: ref PORT_CONTROL_BLOCK,
DATA_BASE: ref USER_DATA_BASE;
! Verify for legal port number and port data base
if (PORT = GAM$SERVICE_PORT (.ARGBLK[RAD_PORT_NUMBER], AF_RAD)) neq 0
then DATA_BASE = .PORT[PCB_DATA_BASE] ! Get user data base address
else begin ! Failed to get port control block
ARGBLK[RAD_STATE] = AS_UND;
ARGBLK[RAD_RETURN_CODE] = AC_BPN;
return;
end;
if .DATA_BASE[UDB_ABORT_LENGTH] eql 0
then ARGBLK[RAD_RETURN_CODE] = AC_NDA
else begin
local PTR;
ARGBLK[RAD_RETURN_CODE] = AC_SUC;
ARGBLK[RAD_ABORT_STATUS] = .DATA_BASE[UDB_ABORT_STATUS];
ARGBLK[RAD_STATE] = .PORT[PCB_STATE];
ARGBLK[RAD_LENGTH] = .DATA_BASE[UDB_ABORT_LENGTH] - 5;
PTR = ch$ptr (DATA_BASE[UDB_ABORT_DATA],,8);
ARGBLK[RAD_ABORT_REASON] = ch$rchar_a (PTR);
ch$move (4, .PTR, ch$ptr (ARGBLK[RAD_SENSE_CODE],,8));
PTR = ch$plus (.PTR, 4);
ch$move (.ARGBLK[RAD_LENGTH], .PTR, .ARGBLK[RAD_DATA]);
end;
return;
end; ! End of A_RAD
%global_routine ('A_RBD', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%RBD Read BIND Data
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
PORT: ref PORT_CONTROL_BLOCK,
DATA_BASE: ref USER_DATA_BASE;
! Verify for legal port number and port data base
if (PORT = GAM$SERVICE_PORT (.ARGBLK[RBD_PORT_NUMBER], AF_RBD)) neq 0
then DATA_BASE = .PORT[PCB_DATA_BASE] ! Get user data base address
else begin ! Failed to get port control block
ARGBLK[RBD_RETURN_CODE] = AC_BPN;
return;
end;
if .DATA_BASE[UDB_BIND_LENGTH] eql 0
then ARGBLK[RBD_RETURN_CODE] = AC_NDA
else begin
ARGBLK[RBD_RETURN_CODE] = AC_SUC;
ARGBLK[RBD_BIND_LENGTH] = .DATA_BASE[UDB_BIND_LENGTH];
ch$move (.ARGBLK[RBD_BIND_LENGTH], ch$ptr (DATA_BASE[UDB_BIND_DATA],,8), .ARGBLK[RBD_BIND_DATA]);
end;
return;
end; ! End of A_RBD
%global_routine ('A_RCN', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%RCN Reconnect to IBM application
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
POINTER,
LENGTH,
PORT: ref PORT_CONTROL_BLOCK,
DATA_BASE: ref USER_DATA_BASE;
! Verify for legal port number and port data base
if (PORT = GAM$VERIFY_PORT (.ARGBLK[RCN_PORT_NUMBER], AF_RCN)) neq 0
then DATA_BASE = .PORT[PCB_DATA_BASE] ! Get user data base address
else begin ! Failed to get port control block
ARGBLK[RCN_RETURN_CODE] = AC_BPN;
return;
end;
if .PORT[PCB_STATE] eql AS_RCN
then
GAP$O_RECONNECT (.ARGBLK, .PORT[PCB_OUTPUT_BUFFER], LENGTH)
else begin
ARGBLK[RCN_RETURN_CODE] = AC_RCE;
return;
end;
POINTER = ch$ptr (.PORT[PCB_OUTPUT_BUFFER],,8); ! Pointer to message buffer
if GAD$SEND_DATA (.PORT[PCB_JFN], .POINTER, .LENGTH)
then begin ! Send Reconnect request
PORT[PCB_STATE] = AS_BNW; ! Update port state
ch$fill (0, .DATA_BASE[UDB_DATA_LENGTH], ch$ptr (DATA_BASE[UDB_USER_DATA],,8));
DATA_BASE[UDB_DATA_LENGTH] = 0;
end
else begin
ARGBLK[RCN_RETURN_CODE] = AC_SER;
return;
end;
ARGBLK[RCN_RETURN_CODE] = AC_SUC;
return;
end; ! End of A_RCN
%global_routine ('A_TRA', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%TRA Transmit data to an IBM appliction
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
LENGTH,
PTR,
PORT: ref PORT_CONTROL_BLOCK;
! Verify for legal port number and port data base
if (PORT = GAM$VERIFY_PORT (.ARGBLK[TRA_PORT_NUMBER], AF_TRA)) eql 0
then begin
ARGBLK[TRA_RETURN_CODE] = AC_BPN;
return;
end;
! Check data length with current packet size of the port. If
! length exceeds packet size then return without sending any data.
if .ARGBLK[TRA_DATA_LENGTH] gtr .PORT[PCB_PACKET_SIZE]
then begin
ARGBLK[TRA_RETURN_CODE] = AC_BTL;
return;
end;
! Assemble protocol DATA message
if .ARGBLK[TRA_DATA_TYPE]
then begin
local COUNT,
TMPBUF: block [6];
! Assemble protocol SEND INTERRUPT message
XERO (TMPBUF, 6);
PTR = ch$ptr (TMPBUF,,8);
PTR = ch$move (2, ch$ptr (ARGBLK[TRA_SEQ_NUMBER],,8), .PTR);
PTR = ch$move (3, ch$ptr (ARGBLK[TRA_RH],,8), .PTR);
ch$move (.ARGBLK[TRA_DATA_LENGTH], .ARGBLK[TRA_DATA_POINTER], .PTR);
PTR = ch$ptr (TMPBUF,,8);
COUNT = .ARGBLK[TRA_DATA_LENGTH] + 5;
if not GAD$SEND_INTERRUPT (.PORT[PCB_JFN], .PTR, .COUNT)
then ARGBLK[TRA_RETURN_CODE] = AC_SIE
else begin
ARGBLK[TRA_RETURN_CODE] = AC_SUC;
ARGBLK[TRA_DATA_LENGTH] = .COUNT - 5;
end;
end
else begin
GAP$O_DATA (.ARGBLK, .PORT[PCB_OUTPUT_BUFFER], LENGTH);
if (.PORT[PCB_STATE] eql AS_RUN)
and GAD$SEND_DATA (.PORT[PCB_JFN], ch$ptr (.PORT[PCB_OUTPUT_BUFFER],,8), .LENGTH)
then ARGBLK[TRA_RETURN_CODE] = AC_SUC
else ARGBLK[TRA_RETURN_CODE] = AC_SER;
end;
return;
end; ! End of A_TRA
%global_routine ('A_TER', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%TER Terminate Port Access
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
PORT: ref PORT_CONTROL_BLOCK;
! Verify for legal port number and port data base
if (PORT = GAM$VERIFY_PORT (.ARGBLK[TER_PORT_NUMBER], AF_TER)) eql 0
then begin
ARGBLK[TER_RETURN_CODE] = AC_BPN;
return;
end;
PORT[PCB_STATE] = AS_ABG; ! Port state aborting
! Send TERMINATE message
GAL$TERMINATE (.PORT[PCB_JFN], .ARGBLK[TER_SENSE_CODE], AR_UAB);
! Disconnect logical link
if not GAD$DISCONNECT_LINK (.PORT[PCB_JFN])
then GAD$ABORT_LINK (.PORT[PCB_JFN]);
ARGBLK[TER_RETURN_CODE] = AC_SUC;
PORT[PCB_STATE] = AS_ABD;
! Erase port data base
FREECI = .FREECI - 1;
FREECP[.FREECI] = .ARGBLK[TER_PORT_NUMBER];
return;
end; ! End of A_TER
%global_routine ('A_LIS', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%LIS Listen for IBM BIND connect
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
own
DESCRIPTOR: CH$SEQUENCE (80);
local
SNABUF: CH$SEQUENCE (280, 8);
local
JFN,
PTR,
LENGTH,
SNA_GATEWAY,
STATUS,
BUF: block [2],
POINTER,
OBJECT,
SYSERR,
PORT: ref PORT_CONTROL_BLOCK,
DATA_BASE: ref USER_DATA_BASE;
if .FREECI geq MAXIMUM_SUPPORTED_PORTS
then begin ! Run out of ports to allocate
ARGBLK[LIS_RETURN_CODE] = AC_IAR;
return;
end;
DATA_BASE = .ARGBLK[WORKING_AREA]; ! Get port data base
! Get the target task name
POINTER = ch$ptr (DESCRIPTOR);
OBJECT = ch$ptr (uplit ('-10'));
STATUS = GAD$NETWORK_DESCRIPTOR (.POINTER, .ARGBLK[LIS_NODE_NAME], .OBJECT);
if .STATUS neq $TRUE
then begin ! Failed to build the DCN: filespec
ARGBLK[LIS_RETURN_CODE] = (selectone .STATUS of
set
[-1]: AC_NLN;
[otherwise]: AC_PER;
tes);
return;
end;
STATUS = GAD$OPEN_LINK (.POINTER, JFN, SYSERR);
if .STATUS neq $TRUE
then begin ! Failed to connect to the Gateway
ARGBLK[LIS_RETURN_CODE] = (selectone .STATUS of
set
[$FALSE]: AC_DCE;
[-1]: AC_DCE;
[otherwise]: AC_PER;
tes);
ARGBLK[LIS_NODE_NAME] = .SYSERR;
return;
end;
! Assemble protocol message
GAP$O_LISTEN (.ARGBLK, SNABUF, LENGTH);
! Send LISTEN for BIND message to Gateway node
if not GAD$EC_SEND_DATA (.JFN, ch$ptr (SNABUF,,8), .LENGTH, SYSERR)
then begin
GAD$ABORT_LINK (.JFN);
ARGBLK[LIS_RETURN_CODE] = .ARGBLK[LIS_RETURN_CODE] or AC_DCE;
ARGBLK[LIS_NODE_NAME] = .SYSERR
end
else begin
local
INTERRUPT_CHANNEL,
PORT_NUMBER,
LEN,
PTR;
INTERRUPT_CHANNEL = .ARGBLK[LIS_PORT_NUMBER];
ARGBLK[LIS_PORT_NUMBER] = PORT_NUMBER = .FREECP[.FREECI];
FREECI = .FREECI + 1; ! Push down on stack
PORT = SNAVCB[.PORT_NUMBER,PCB_BLOCK_FIELD]; ! Get control block
ch$fill (0, PORT_CONTROL_BLOCK_SIZE, ch$ptr (.PORT,,36));
PORT[PCB_JFN] = .JFN; ! Save DECnet logical link JFN
PORT[PCB_STATE] = AS_BNW; ! Set port state to BINDWAIT
PORT[PCB_ERROR] = 0; ! No error
PORT[PCB_RCV_INTERRUPT] = $FALSE;
PORT[PCB_PACKET_SIZE] = 0;
PORT[PCB_RESET_SEEN] = 0; ! No reset seen yet
PORT[PCB_DATA_BASE] = .DATA_BASE; ! Save user data base address
PORT[PCB_INPUT_BUFFER] = SNAIOB[.PORT_NUMBER,IOB_INPUT_BUFFER];
PORT[PCB_OUTPUT_BUFFER] = SNAIOB[.PORT_NUMBER,IOB_OUTPUT_BUFFER];
if GAD$PSI_CHANNELS (.JFN, .INTERRUPT_CHANNEL)
then ARGBLK[LIS_RETURN_CODE] = AC_SUC
else begin ! Failed to set up PSI channel
GAD$ABORT_LINK (.JFN);
ARGBLK[LIS_RETURN_CODE] = .ARGBLK[LIS_RETURN_CODE] or AC_PSE;
return;
end;
if .PORT[PCB_PACKET_SIZE] leq 0
then PORT[PCB_PACKET_SIZE] = 1 ^ AF_STANDARD_PACKET_SIZE;
end;
return;
end; ! End of A_LIS
%routine ('GAM$VERIFY_PORT', PORT_NUMBER, FUNCTION) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Function to verify the validity of the port for a particular
! network function.
!
! FORMAL PARAMETERS:
!
! PORT_NUMBER Port number of the verified port data base.
! FUNCTION The gateway access protocol function to be performed
! for the port.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! ROUTINE VALUE:
!
! >0 Successful verification. Port control block address
! is returned.
! 0 Failed.
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
PORT: ref PORT_CONTROL_BLOCK;
PORT = SNAVCB[.PORT_NUMBER,PCB_BLOCK_FIELD]; ! Get port address
if .PORT[PCB_JFN] leq 0 ! Check port JFN
then return 0;
if not GAM$PORT_STATE (.FUNCTION, .PORT[PCB_STATE]) ! Check port state
then return 0;
return .PORT; ! Return port address
end; ! End of GAM$VERIFY_PORT
%routine ('GAM$SERVICE_PORT', PORT_NUMBER, FUNCTION) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Function to verify the validity of the port for a particular
! network function, then service it at the logical link level.
!
! FORMAL PARAMETERS:
!
! PORT_NUMBER Port number of the verified port data base.
! FUNCTION The gateway access protocol function to be performed
! for the port.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! ROUTINE VALUE:
!
! >0 Successful verification. Port control block address
! is returned.
! 0 Failed.
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
PORT: ref PORT_CONTROL_BLOCK;
PORT = SNAVCB[.PORT_NUMBER,PCB_BLOCK_FIELD]; ! Get port address
if .PORT[PCB_JFN] leq 0 ! Check port JFN
then return 0;
if not GAM$PORT_STATE (.FUNCTION, .PORT[PCB_STATE]) ! Check port state
then return 0;
GAL$LINK_SERVICE (.PORT); ! Service port at logical link level
return .PORT; ! Return port address
end; ! End of GAM$SERVICE_PORT
%routine ('GAM$PORT_STATE', FUNCTION, STATE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Function to verify the validity of the port state upon performing
! a network function.
!
! FORMAL PARAMETERS:
!
! FUNCTION The gateway access protocol function to be performed
! for the port.
! STATE Current port state.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! ROUTINE VALUE:
!
! $TRUE Successful verification.
! $FALSE Failed.
!
! SIDE EFFECTS:
!
! none
!
!--
begin
selectone .FUNCTION of ! Check port state
set
[AF_ACC, ! A%ACC (Accept Incoming BIND)
AF_REJ, ! A%REJ (Reject Incoming BIND)
AF_RBD]: ! A%RBD (Read Bind Data)
if PORT_STATE (.STATE, AS_BNR)
then return $TRUE;
[AF_REC]: ! A%REC (Recieve Data Message)
if PORT_STATE (.STATE, AS_RUN, AS_ABG, AS_FLU)
then return $TRUE;
[AF_REM]: ! A%REM (Read Interrupt Message)
if PORT_STATE (.STATE, AS_RUN, AS_ABG, AS_FLU)
then return $TRUE;
[AF_RCN]: ! A%RCN (Re-Connect)
if PORT_STATE (.STATE, AS_RUN, AS_RCN, AS_FLU)
then return $TRUE;
[AF_TRA]: ! A%TRA (Transmit Data Message)
if PORT_STATE (.STATE, AS_RUN, AS_ABG, AS_FLU)
then return $TRUE;
[AF_CON, ! A%CON (Connect to IBM)
AF_LIS]: ! A%LIS (Listen Incoming Connect)
if PORT_STATE (.STATE, AS_UND)
then return $TRUE;
[AF_RAD]: ! A%RAD (Read Abort Data)
if PORT_STATE (.STATE, AS_ABD, AS_ABG, AS_FLU)
then return $TRUE;
[AF_TER, ! A%TER (Terminate Port Access)
AF_RDE]: ! A%RDE (Read Event data)
return $TRUE;
tes;
return $FALSE;
end; ! End of GAM$PORT_STATE
%routine ('GAM$ASCIZ', SOURCE, DESTINATION) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Function to copy ASCIZ string to a counted ASCII string buffer.
!
! FORMAL PARAMETERS:
!
! SOURCE Pointer to the source string.
! DESTINATION Pointer to the destination location.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
LENGTH;
LENGTH = (if (.SOURCE neq 0) and (ch$size (.SOURCE) gtr 0)
then CH$LEN (.SOURCE) ! Get length of the source string
else 0);
if .LENGTH leq 0
then ch$wchar (%O'0', .DESTINATION) ! Null source string
else begin
local POINTER;
POINTER = .DESTINATION;
ch$wchar_a (.LENGTH, POINTER);
ch$move (.LENGTH, .SOURCE, .POINTER);
end;
return;
end; ! End of GAM$ASCIZ
%routine ('GAM$ASCIC', LENGTH, SOURCE, DESTINATION) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Function to copy string from user argument block to user data base.
! If the source string empty, then zero out the destination location.
!
! FORMAL PARAMETERS:
!
! LENGTH Length of the source string.
! SOURCE Pointer to the source string.
! DESTINATION Pointer to the destination location.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! ROUTINE VALUE:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
if .LENGTH leq 0
then ch$wchar (%O'0', .DESTINATION)
else begin
local POINTER;
POINTER = .DESTINATION;
ch$wchar_a (.LENGTH, POINTER);
ch$move (.LENGTH, .SOURCE, .POINTER);
end;
return;
end; ! End of GAM$ASCIC
%global_routine ('A_OUT', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%OUT Outputs in decimal the binddata or any data
! pointed to.
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
PTR,
NUM,
FLAG,
FILL,
LEN;
PTR = .ARGBLK[RBD_BIND_DATA];
LEN = .ARGBLK[RBD_BIND_LENGTH];
FILL = ch$ptr (uplit (' ,'));
FLAG = 16;
if .ARGBLK[RBD_BIND_LENGTH] eql 0
then ARGBLK[RBD_RETURN_CODE] = AC_PER
else begin
ARGBLK[RBD_RETURN_CODE] = AC_SUC;
while .LEN gtr 0 do
begin
NUM = ch$rchar_a (PTR);
jsys_nout ($priou, .NUM, .FLAG);
jsys_psout (.FILL);
LEN = .LEN - 1;
end;
end;
return;
end; ! End of A_OUT
%global_routine ('A_OAD', ARGBLK: ref ARGUMENT_BLOCK) : MAC novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! A%OAD Output Abort Data
!
! FORMAL PARAMETERS:
!
! ARGBLK Argument block address of the port in AC1.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
PTR,
NUM,
FILL,
FLAG,
CRLFX,
PTRX,
MESPTR,
MESPTRX,
BUFFX,
LEN;
CRLFX = PTRX = ch$ptr (BUFFX);
PTRX = ch$wchar_a (%O'15', PTRX);
PTRX = ch$wchar_a (%O'12', PTRX);
ch$wchar_a (0, PTRX);
PTR = .ARGBLK[RAD_DATA];
LEN = .ARGBLK[RAD_LENGTH];
FILL = ch$ptr (uplit (' ,'));
FLAG = 10;
if .ARGBLK[RAD_LENGTH] eql 0
then ARGBLK[RAD_RETURN_CODE] = AC_PER
else begin
ARGBLK[RAD_RETURN_CODE] = AC_SUC;
while .LEN gtr 0 do
begin
NUM = ch$rchar_a (PTR);
jsys_nout ($priou, .NUM, .FLAG);
jsys_psout (.FILL);
LEN = .LEN - 1;
end;
end;
CRLF (3);
MESPTR = ch$ptr (uplit ('ABORT REASON Code: '));
jsys_psout (.MESPTR);
jsys_nout ($priou, .ARGBLK[RAD_ABORT_REASON], .FLAG);
CRLF (2);
MESPTRX = ch$ptr (uplit ('IBM SENSE Code: '));
jsys_psout (.MESPTRX);
LEN = 4;
FLAG = 16;
PTR = ch$ptr (ARGBLK[RAD_SENSE_CODE],,8);
while .LEN gtr 0 do
begin
NUM = ch$rchar_a (PTR);
jsys_nout ($priou, .NUM, .FLAG);
jsys_psout (.FILL);
LEN = .LEN - 1;
end;
return;
end; ! End of A_OAD
end ! End of SAIMAC
eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:2
! Comment Column:40
! Comment Rounding:+1
! End: