Trailing-Edge
-
PDP-10 Archives
-
BB-P363B-SM_1985
-
mcb/cex/dtr.b16
There are no other files named dtr.b16 in the archive.
module DTR ( ! DECnet Test Receiver
ident = 'X01110',
language (bliss16) ,
list (require)
) =
begin
!
! COPYRIGHT (c) 1980, 1981, 1982
! 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: DECnet Test Receiver
!
! ABSTRACT:
!
! This is a hack attempt to implement DTR in the DN20.
!
! ENVIRONMENT: MCB V3.0
!
! AUTHOR: Alan D. Peckham CREATION DATE: 25-Nov-80
!
! MODIFIED BY:
!
! Alan Peckham, 27-Nov-80
! 01 - New process for DN20 testing.
! 02 - Various bug fixes.
! 03 - Add disconnect test.
! 04 - Update for MCB V3.1
! 05 - Add interrupt sink and received tests.
! 06 - Pass EOM from received segment to sent during data test.
!
! Ron Platukis, 23-jan-81
! 07 - Add sequence and pattern tests for interrupt and normal data.
! 08 - On Reject set C_PRM2 eql S_ERBO.
! 09 - Clear ls_active in RCV_ACC if accept failed.
! 10 - Source/Object skew. This is to make sure it is updated.
! 11 - Do not use SDBs.
!--
!
! INCLUDE FILES:
!
library 'MCB:MCBLIB';
library 'MCB:XPORTX';
require 'MCB:SCSYS';
require 'DTRDAT';
!
! TABLE OF CONTENTS:
!
forward routine
DTRTIM : MCB_DB_MOD novalue,
RCV_ABO : MCB_DB_CCB novalue,
RCV_ACC : MCB_DB_CCB novalue,
RCV_CNR : MCB_DB_CCB novalue,
RCV_DAT : MCB_DB_CCB novalue,
RCV_DIS : MCB_DB_CCB novalue,
RCV_DRQ : MCB_DB_CCB novalue,
RCV_DSR : MCB_DB_CCB novalue,
RCV_INT : MCB_DB_CCB novalue,
RCV_IRQ : MCB_DB_CCB novalue,
RCV_REJ : MCB_DB_CCB novalue,
RCV_SND : MCB_DB_CCB novalue,
RCV_SNI : MCB_DB_CCB novalue,
SND_ABO : LINKAGE_DB_CCB novalue,
SND_ACC : LINKAGE_DB_CCB novalue,
SND_DIS : LINKAGE_DB_CCB novalue,
SND_DRQ : LINKAGE_DB_CCB novalue,
SND_IRQ : LINKAGE_DB_CCB novalue,
SND_REJ : LINKAGE_DB_CCB novalue,
SND_SND : LINKAGE_DB_CCB novalue,
SND_SNI : LINKAGE_DB_CCB novalue,
PATTERN_CHECK: LINKAGE_DB_CCB;
!
! MACROS:
!
! None
!
! EQUATED SYMBOLS:
!
literal
FALSE = 1 eql 0,
NO_OPERATION = 0,
TRUE = 1 eql 1;
global literal
%name ('D.LEN') = D_LENGTH^1,
%name ('L.LEN') = L_LENGTH^1;
field word_0 = [0, 0, 16, 0],
word_1 = [1, 0, 16, 0],
byte_0 = [0, 0, 8, 0],
byte_1 = [0, 8, 8, 0];
!
! OWN STORAGE:
!
external routine
$DSPCR : novalue;
routine SCRCP (DB, CCB, MODF) : MCB_DB_CCB_MOD novalue =
DISPATCH$ (TABLE$ ($DSPCR, 6,
(S$CNR, RCV_CNR),
(S$DAT, RCV_DAT),
(S$DSR, RCV_DSR),
(S$INT, RCV_INT)),
.MODF, (.DB, .CCB), MCB_DB_CCB);
routine SCXCP (DB, CCB, MODF) : MCB_DB_CCB_MOD novalue =
DISPATCH$ (TABLE$ ($DSPCR, 20,
(S$ABO, RCV_ABO),
(S$ACC, RCV_ACC),
(S$DIS, RCV_DIS),
(S$DRQ, RCV_DRQ),
(S$IRQ, RCV_IRQ),
(S$REJ, RCV_REJ),
(S$SND, RCV_SND),
(S$SNI, RCV_SNI)),
.MODF, (.DB, .CCB), MCB_DB_CCB);
$MCB_PROCESS (NAME = DTR, ! Process name
LLC_DISPATCH = TABLE$ ($DSPCR, FC_CCP, ! LLC Dispatch vector:
(FC_RCP, SCRCP),
(FC_XCP, SCXCP),
(FC_TIM, DTRTIM))); ! timeout
!
! EXTERNAL REFERENCES:
!
! None
routine DTRTIM (DB, MODF) : MCB_DB_MOD novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
DB : ref block field (D_FIELDS);
0
end; !of routine DTRTIM
routine RCV_ABO (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
bind
LINK = blockvector [.DB [D_ADDR], .CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] - 1, 0, 0, 0, 0; 0, L_LENGTH]
: block field (L_FIELDS);
if .CCB [C_STS] neq S_SSUC
then
SIGNAL (DTR$_NO_ABORT, .CCB, .CCB [C_STS]);
LINK [ls_dip] = false;
LINK [LS_ACTIVE] = FALSE;
CCBRT$ (.CCB);
end; !of routine RCV_ABO
routine RCV_ACC (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
bind
LINK = blockvector [.DB [D_ADDR], .CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] - 1, 0, 0, 0, 0; 0, L_LENGTH]
: block field (L_FIELDS);
if .CCB [C_STS] neq S_SSUC
then
begin
SIGNAL (DTR$_NO_ACCEPT, .CCB, .CCB [C_STS]);
LINK[ LS_active] = false;
return CCBRT$ (.CCB);
end;
case .LINK [L_TEST] from 0 to 3 of
set
[0] :
CCBRT$ (.CCB);
[1] :
selectone .LINK [L_FLOW_TYPE] of
set
[0] :
CCBRT$ (.CCB);
[1] :
begin
CCB [C_BIAS] = CCB [C_ADDR] = CCB [C_CNT] = 0;
SND_DRQ (.DB, .CCB, .CCB [C_PIX], .CCB [C_LIX], .CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)], .LINK [L_FLOW_COUNT]);
end;
[2] :
CCBRT$ (.CCB);
tes;
[2] :
begin
CCB [C_BIAS] = 0;
CCB [C_ADDR] = ch$ptr (LINK [L_DISCONNECT_DATA]);
CCB [C_CNT] = .LINK [L_DISCONNECT_LENGTH];
if .LINK [$SUB_FIELD (L_SUB_TEST, 0, 0, 1, 0)] eql 0
then
SND_DIS (.DB, .CCB, .CCB [C_PIX], .LINK [L_LLA], .LINK [L_ULA])
else
SND_ABO (.DB, .CCB, .CCB [C_PIX], .LINK [L_LLA], .LINK [L_ULA]);
end;
[inrange] :
CCBRT$ (.CCB);
tes;
end; !of routine RCV_ACC
routine RCV_CNR (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
local
LINK : ref block field (L_FIELDS),
SC_PIX;
SC_PIX = .CCB [C_PIX];
LINK = .DB [D_ADDR];
while .LINK [LS_ACTIVE] do
begin
if .LINK [L_ULA] geq .DB [D_LINKS]
then
begin
CCB [C_STS] = S_ERES %(no resources)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .CCB [C_LIX];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
LINK = vector [.LINK, L_LENGTH];
end;
begin
local
PTR;
LINK [L_LLA] = .CCB [C_LIX];
MAP$ (.CCB [C_BIAS]);
PTR = ch$ptr (block [.CCB [C_ADDR], CB_OPTD],, 8);
LINK [L_TEST] = ch$rchar_a (PTR);
LINK [LS_PROPT] = .LINK [$SUB_FIELD (L_TEST, 0, 7, 1, 1)];
LINK [$SUB_FIELD (L_TEST, 0, 7, 1, 1)] = 0;
case .LINK [L_TEST] from 0 to 3 of
set
[0] :
begin
case (LINK [L_SUB_TEST] =
begin
local char;
char = ch$rchar_a (PTR);
.char
end) from 0 to 5 of
set
[0, 1] :
LINK [L_DISCONNECT_LENGTH] = 0;
[2, 3] :
ch$move ((LINK [L_DISCONNECT_LENGTH] = 16),
ch$ptr (uplit ('ABCDEFGHIJKLMNOP')),
ch$ptr (LINK [L_DISCONNECT_DATA]));
[4, 5] :
ch$move ((LINK [L_DISCONNECT_LENGTH] = .block [.CCB [C_ADDR], CB_OPDL]),
ch$ptr (block [.CCB [C_ADDR], CB_OPTD]),
ch$ptr (LINK [L_DISCONNECT_DATA]));
[outrange] :
begin
CCB [C_STS] = S_ERBO %(invalid test sub-type)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
tes;
begin
local
ACC_CCB : ref block field (C_FIELDS);
if not CCBGT$ (ACC_CCB)
then
begin
CCB [C_STS] = S_ERES %(no resources)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
ACC_CCB [C_BIAS] = 0;
ACC_CCB [C_ADDR] = ch$ptr (LINK [L_DISCONNECT_DATA]);
ACC_CCB [C_CNT] = .LINK [L_DISCONNECT_LENGTH];
if .LINK [$SUB_FIELD (L_SUB_TEST, 0, 0, 1, 0)] eql 0
then
SND_REJ (.DB, .ACC_CCB, .SC_PIX, .LINK [L_LLA], .LINK [L_ULA])
else
SND_ACC (.DB, .ACC_CCB, .SC_PIX, .LINK [L_LLA], .LINK [L_ULA], S$PMSG);
end;
LINK [LS_ACTIVE] = TRUE;
end;
[1] :
begin
local
CHAR;
selectone (CHAR = ch$rchar_a (PTR)) of
set
[0, 1, 2, 3] :
LINK [L_SUB_TEST] = .CHAR;
[otherwise] :
begin
CCB [C_STS] = S_ERBO %(invalid data type)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
tes;
selectone (CHAR = ch$rchar_a (PTR)) of
set
[1] :
LINK [L_FLOW_TYPE] = .CHAR;
[0, 2] :
begin
CCB [C_STS] = S_ERBO %(unsupported flow type)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
[otherwise] :
begin
CCB [C_STS] = S_ERBO %(invalid flow control option)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
tes;
selectone (CHAR = ch$rchar_a (PTR)) of
set
[1 to 127] :
LINK [L_FLOW_COUNT] = .CHAR;
[otherwise] :
begin
CCB [C_STS] = S_ERBO %(invalid flow control value)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
tes;
selectone (CHAR = ch$rchar_a (PTR)) of
set
[0] :
LINK [L_NAK_COUNT] = .CHAR;
[1 to 128] :
begin
CCB [C_STS] = S_ERBO %(unsupported nak frequency)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
[otherwise] :
begin
CCB [C_STS] = S_ERBO %(invalid nak frequency)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
tes;
selectone (CHAR = ch$rchar_a (PTR)) of
set
[0] :
LINK [L_BPC_COUNT] = .CHAR;
[1 to 128] :
begin
CCB [C_STS] = S_ERBO %(unsupported back-pressure frequency)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
[otherwise] :
begin
CCB [C_STS] = S_ERBO %(invalid back-pressure frequency)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
tes;
LINK [$SUB_FIELD (L_MESSAGE_SIZE, 0, 0, 8, 0)] = ch$rchar_a (PTR);
LINK [$SUB_FIELD (L_MESSAGE_SIZE, 0, 8, 8, 0)] = ch$rchar_a (PTR);
incra ADDRESS from LINK [L_SEND_NUMBER] to LINK [L_PATTERN_ROUTINE] by %upval do .ADDRESS = 0;
begin
local
ACC_CCB : ref block field (C_FIELDS);
bind
FLOW = uplit (0, S$PSEG, S$PMSG) : vector;
if not CCBGT$ (ACC_CCB)
then
begin
CCB [C_STS] = S_ERES %(no resources)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
ACC_CCB [C_BIAS] = ACC_CCB [C_ADDR] = ACC_CCB [C_CNT] = 0;
SND_ACC (.DB, .ACC_CCB, .SC_PIX, .LINK [L_LLA], .LINK [L_ULA], .FLOW [.LINK [L_FLOW_TYPE]]);
end;
LINK [LS_ACTIVE] = TRUE;
end;
[2] :
begin
case (LINK [L_SUB_TEST] =
begin
local char;
char = ch$rchar_a (PTR);
.char
end) from 0 to 5 of
set
[0, 1] :
LINK [L_DISCONNECT_LENGTH] = 0;
[2, 3] :
ch$move ((LINK [L_DISCONNECT_LENGTH] = 16),
ch$ptr (uplit ('ABCDEFGHIJKLMNOP')),
ch$ptr (LINK [L_DISCONNECT_DATA]));
[4, 5] :
ch$move ((LINK [L_DISCONNECT_LENGTH] = .block [.CCB [C_ADDR], CB_OPDL]),
ch$ptr (block [.CCB [C_ADDR], CB_OPTD]),
ch$ptr (LINK [L_DISCONNECT_DATA]));
[outrange] :
begin
CCB [C_STS] = S_ERBO %(invalid test sub-type)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
tes;
begin
local
ACC_CCB : ref block field (C_FIELDS);
if not CCBGT$ (ACC_CCB)
then
begin
CCB [C_STS] = S_ERES %(no resources)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
ACC_CCB [C_BIAS] = ACC_CCB [C_ADDR] = ACC_CCB [C_CNT] = 0;
SND_ACC (.DB, .ACC_CCB, .SC_PIX, .LINK [L_LLA], .LINK [L_ULA], S$PMSG);
end;
LINK [LS_ACTIVE] = TRUE;
end;
[3] :
begin
local
CHAR;
selectone (CHAR = ch$rchar_a (PTR)) of
set
[0, 1, 2, 3] :
LINK [L_SUB_TEST] = .CHAR;
[otherwise] :
begin
CCB [C_STS] = S_ERBO %(invalid data type)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
tes;
selectone (CHAR = ch$rchar_a (PTR)) of
set
[1] :
LINK [L_FLOW_COUNT] = .CHAR;
[otherwise] :
begin
CCB [C_STS] = S_ERBO %(invalid flow control value)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
tes;
incra ADDRESS from LINK [L_SEND_NUMBER] to LINK [L_PATTERN_ROUTINE] by %upval do .ADDRESS = 0;
begin
local
ACC_CCB : ref block field (C_FIELDS);
if not CCBGT$ (ACC_CCB)
then
begin
CCB [C_STS] = S_ERES %(no resources)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
ACC_CCB [C_BIAS] = ACC_CCB [C_ADDR] = ACC_CCB [C_CNT] = 0;
SND_ACC (.DB, .ACC_CCB, .SC_PIX, .LINK [L_LLA], .LINK [L_ULA], S$PSEG);
end;
LINK [LS_ACTIVE] = TRUE;
end;
[inrange] :
begin
SIGNAL (DTR$_TEST_UNSUPPORTED, .LINK [L_TEST]);
CCB [C_STS] = S_ERBO %(unsupported test type)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
[outrange] :
begin
SIGNAL (DTR$_TEST_INVALID, .LINK [L_TEST]);
CCB [C_STS] = S_ERBO %(invalid test type)%;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .LINK [L_ULA];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
tes;
end;
end; !of routine RCV_CNR
routine RCV_DAT (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
bind
LINK = blockvector [.DB [D_ADDR], .CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] - 1, 0, 0, 0, 0; 0, L_LENGTH]
: block field (L_FIELDS);
if .LINK [L_TEST] neq 1
then
begin
SIGNAL (DTR$_NO_DATA_PLEASE, .CCB);
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
if ( .CCB[$sub_field( C_PRM1, byte_1)] and S$PBOM) neq 0
then
begin
if (LINK[$sub_field( L_RECEIVE_NUMBER, word_0)] = .LINK[$sub_field( L_RECEIVE_NUMBER, word_0)] + 1) eql 0
then
LINK[$sub_field( L_RECEIVE_NUMBER, word_1)] = .LINK[$sub_field( L_RECEIVE_NUMBER, word_1)] + 1;
end;
MAP$( .CCB[C_BIAS]);
selectone .LINK [L_SUB_TEST] of
set
[0]:
begin
local
DRQ_CCB : ref block field (C_FIELDS);
if not CCBGT$ (DRQ_CCB) then return SIGNAL (DTR$_NO_CCB);
DRQ_CCB [C_BIAS] = DRQ_CCB [C_ADDR] = DRQ_CCB [C_CNT] = 0;
SND_DRQ (.DB, .DRQ_CCB, .CCB[C_PIX], .LINK [L_LLA], .LINK [L_ULA], 1);
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
end;
[1, 2]:
begin
if
begin
if ( .CCB[$sub_field( C_PRM1, byte_1)] and S$PBOM) neq 0
then
begin
if ch$eql( 4, .CCB[C_ADDR], 4, ch$ptr(LINK[$sub_field( L_RECEIVE_NUMBER, word_0)]), 0)
then
true
else
begin
SIGNAL (DTR$_BAD_SEQUENCE_NUMBER, .CCB);
false
end
end
else
true
end
and
begin
if .LINK[L_SUB_TEST] eql 2
then
begin
if PATTERN_CHECK( .DB, .CCB)
then
true
else
begin
SIGNAL (DTR$_BAD_PATTERN, .CCB);
false
end
end
else
true
end
then
begin
local
DRQ_CCB : ref block field (C_FIELDS);
if not CCBGT$ (DRQ_CCB) then return SIGNAL (DTR$_NO_CCB);
DRQ_CCB [C_BIAS] = DRQ_CCB [C_ADDR] = DRQ_CCB [C_CNT] = 0;
SND_DRQ (.DB, .DRQ_CCB, .CCB[C_PIX], .LINK [L_LLA], .LINK [L_ULA], 1);
end
else
begin
local
DIS_CCB: ref block field (C_FIELDS);
if not CCBGT$ (DIS_CCB) then signal_stop (DTR$_NO_CCB);
DIS_CCB [C_BIAS] = DIS_CCB [C_ADDR] = DIS_CCB [C_CNT] = 0;
SND_DIS (.DB, .DIS_CCB, .CCB[C_PIX], .LINK[L_LLA], .LINK[L_ULA]);
end;
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
end;
[3] :
begin
local
SND_CCB : ref block field (C_FIELDS);
if not CCBGT$ (SND_CCB) then return SIGNAL (DTR$_NO_CCB);
SND_CCB [C_STK] = .CCB;
SND_CCB [C_BIAS] = .CCB [C_BIAS];
SND_CCB [C_ADDR] = .CCB [C_ADDR];
SND_CCB [C_CNT] = .CCB [C_CNT];
SND_CCB [C_CHN] = .CCB [C_CHN];
SND_SND (.DB, .SND_CCB, .CCB [C_PIX], .LINK [L_LLA], .LINK [L_ULA],
(if ( .CCB[$sub_field( C_PRM1, byte_1)] and S$PEOM) neq 0 then S$PEOM else 0));
end;
tes;
end; !of routine RCV_DAT
routine RCV_DIS (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
bind
LINK = blockvector [.DB [D_ADDR], .CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] - 1, 0, 0, 0, 0; 0, L_LENGTH]
: block field (L_FIELDS);
if .CCB [C_STS] neq S_SSUC
then
SIGNAL (DTR$_NO_DISCONNECT, .CCB, .CCB [C_STS]);
LINK [ls_dip] = false;
LINK [LS_ACTIVE] = FALSE;
CCBRT$ (.CCB);
end; !of routine RCV_DIS
routine RCV_DRQ (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
if .CCB [C_STS] neq S_SSUC
then
SIGNAL (DTR$_NO_DATA_REQUEST, .CCB, .CCB [C_STS]);
$MCB_RETURN_CCB (.CCB);
end; !of routine RCV_DRQ
routine RCV_DSR (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
local
DIS_CCB : ref block field (C_FIELDS),
LLA,
SC_PIX,
ULA;
SC_PIX = .CCB [C_PIX];
LLA = .CCB [C_LIN];
ULA = .CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)];
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
if not CCBGT$ (DIS_CCB) then signal_stop (DTR$_NO_CCB);
DIS_CCB [C_BIAS] = DIS_CCB [C_ADDR] = DIS_CCB [C_CNT] = 0;
SND_DIS (.DB, .DIS_CCB, .SC_PIX, .LLA, .ULA);
end; !of routine RCV_DSR
routine RCV_INT (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
bind
LINK = blockvector [.DB [D_ADDR], .CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] - 1, 0, 0, 0, 0; 0, L_LENGTH]
: block field (L_FIELDS);
if .LINK [L_TEST] neq 3
then
begin
SIGNAL (DTR$_NO_INTERRUPT_PLEASE, .CCB);
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
return;
end;
if (LINK[$sub_field( L_RECEIVE_NUMBER, word_0)] = .LINK[$sub_field( L_RECEIVE_NUMBER, word_0)] + 1) eql 0
then
LINK[$sub_field( L_RECEIVE_NUMBER, word_1)] = .LINK[$sub_field( L_RECEIVE_NUMBER, word_1)] + 1;
MAP$( .CCB[C_BIAS]);
selectone .LINK [L_SUB_TEST] of
set
[0] :
begin
local
IRQ_CCB : ref block field (C_FIELDS);
if not CCBGT$ (IRQ_CCB) then return SIGNAL (DTR$_NO_CCB);
IRQ_CCB [C_BIAS] = IRQ_CCB [C_ADDR] = IRQ_CCB [C_CNT] = 0;
SND_IRQ (.DB, .IRQ_CCB, .CCB[C_PIX], .LINK [L_LLA], .LINK [L_ULA]);
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
end;
[1, 2]:
begin
if
begin
if ch$eql( 4, .CCB[C_ADDR], 4, ch$ptr(LINK[$sub_field( L_RECEIVE_NUMBER, word_0)]), 0)
then
true
else
begin
SIGNAL (DTR$_BAD_SEQUENCE_NUMBER, .CCB);
false
end
end
and
begin
if .LINK[L_SUB_TEST] eql 2
then
begin
if PATTERN_CHECK( .DB, .CCB)
then
true
else
begin
SIGNAL (DTR$_BAD_PATTERN, .CCB);
false
end
end
else
true
end
then
begin
local
IRQ_CCB : ref block field (C_FIELDS);
if not CCBGT$ (IRQ_CCB) then return SIGNAL (DTR$_NO_CCB);
IRQ_CCB [C_BIAS] = IRQ_CCB [C_ADDR] = IRQ_CCB [C_CNT] = 0;
SND_IRQ (.DB, .IRQ_CCB, .CCB[C_PIX], .LINK [L_LLA], .LINK [L_ULA]);
end
else
begin
local
DIS_CCB: ref block field (C_FIELDS);
SIGNAL (DTR$_BAD_SEQUENCE_NUMBER, .CCB);
if not CCBGT$ (DIS_CCB) then signal_stop (DTR$_NO_CCB);
DIS_CCB [C_BIAS] = DIS_CCB [C_ADDR] = DIS_CCB [C_CNT] = 0;
SND_DIS (.DB, .DIS_CCB, .CCB[C_PIX], .LINK[L_LLA], .LINK[L_ULA]);
end;
CCB [C_FNC] = FC_RCE;
LLCRS$ (.CCB);
end;
[3] :
begin
local
SNI_CCB : ref block field (C_FIELDS);
if not CCBGT$ (SNI_CCB) then return SIGNAL (DTR$_NO_CCB);
SNI_CCB [C_STK] = .CCB;
SNI_CCB [C_BIAS] = .CCB [C_BIAS];
SNI_CCB [C_ADDR] = .CCB [C_ADDR];
SNI_CCB [C_CNT] = .CCB [C_CNT];
SNI_CCB [C_CHN] = .CCB [C_CHN];
SND_SNI (.DB, .SNI_CCB, .CCB [C_PIX], .LINK [L_LLA], .LINK [L_ULA]);
end;
tes;
end; !of routine RCV_INT
routine RCV_IRQ (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
if .CCB [C_STS] neq S_SSUC
then
SIGNAL (DTR$_NO_INTERRUPT_REQUEST, .CCB, .CCB [C_STS]);
$MCB_RETURN_CCB (.CCB);
end; !of routine RCV_IRQ
routine RCV_REJ (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
bind
LINK = blockvector [.DB [D_ADDR], .CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] - 1, 0, 0, 0, 0; 0, L_LENGTH]
: block field (L_FIELDS);
if .CCB [C_STS] neq S_SSUC
then
SIGNAL (DTR$_NO_REJECT, .CCB, .CCB [C_STS]);
LINK [ls_dip] = false;
LINK [LS_ACTIVE] = FALSE;
CCBRT$ (.CCB);
end; !of routine RCV_REJ
routine RCV_SND (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
begin
bind
RCV_CCB = .CCB [C_STK] : block field (C_FIELDS);
if .CCB [C_STS] neq S_SSUC
then
SIGNAL (DTR$_NO_SEND_DATA, .CCB, .CCB [C_STS]);
if .CCB [C_BIAS] eql .RCV_CCB [C_BIAS]
then
CCB [C_BIAS] = CCB [C_ADDR] = CCB [C_CNT] = 0;
CCB [C_CHN] = 0;
RCV_CCB [C_FNC] = FC_RCE;
LLCRS$ (RCV_CCB);
CCB [C_STK] = 0;
end;
SND_DRQ (.DB, .CCB, .CCB [C_PIX], .CCB [C_LIX], .CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)], 1);
end; !of routine RCV_SND
routine RCV_SNI (DB, CCB) : MCB_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
begin
bind
RCV_CCB = .CCB [C_STK] : block field (C_FIELDS);
if .CCB [C_STS] neq S_SSUC
then
SIGNAL (DTR$_NO_SEND_INTERRUPT, .CCB, .CCB [C_STS]);
if .CCB [C_BIAS] eql .RCV_CCB [C_BIAS]
then
CCB [C_BIAS] = CCB [C_ADDR] = CCB [C_CNT] = 0;
CCB [C_CHN] = 0;
RCV_CCB [C_FNC] = FC_RCE;
LLCRS$ (RCV_CCB);
CCB [C_STK] = 0;
end;
SND_IRQ (.DB, .CCB, .CCB [C_PIX], .CCB [C_LIX], .CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)]);
end; !of routine RCV_SNI
routine SND_ABO (DB, CCB, PIX, LLA, ULA) : LINKAGE_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
bind
LINK = blockvector [.DB [D_ADDR], .ULA - 1, 0, 0, 0, 0; 0, L_LENGTH]
: block field (L_FIELDS);
LINK [ls_dip] = true;
CCB [C_PIX] = .PIX;
CCB [C_LIX] = .LLA;
CCB [C_FNC] = FC_XME;
CCB [C_MOD] = S$ABO;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .ULA;
LLCRS$ (.CCB);
end; !of routine SND_ABO
routine SND_ACC (DB, CCB, PIX, LLA, ULA, FLOW) : LINKAGE_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
CCB [C_PIX] = .PIX;
CCB [C_FNC] = FC_XME;
CCB [C_MOD] = S$ACC;
CCB [C_LIN] = .LLA;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .ULA;
CCB [$SUB_FIELD (C_PRM1, 0, 8, 8, 0)] = .FLOW;
LLCRS$ (.CCB);
end; !of routine SND_ACC
routine SND_DIS (DB, CCB, PIX, LLA, ULA) : LINKAGE_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
bind
LINK = blockvector [.DB [D_ADDR], .ULA - 1, 0, 0, 0, 0; 0, L_LENGTH]
: block field (L_FIELDS);
LINK [ls_dip] = true;
CCB [C_PIX] = .PIX;
CCB [C_LIX] = .LLA;
CCB [C_FNC] = FC_XME;
CCB [C_MOD] = S$DIS;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .ULA;
LLCRS$ (.CCB);
end; !of routine SND_DIS
routine SND_DRQ (DB, CCB, PIX, LLA, ULA, SEG) : LINKAGE_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
CCB [C_PIX] = .PIX;
CCB [C_LIX] = .LLA;
CCB [C_FNC] = FC_XME;
CCB [C_MOD] = S$DRQ;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .ULA;
CCB [$SUB_FIELD (C_PRM1, 0, 8, 8, 0)] = .SEG;
LLCRS$ (.CCB);
end; !of routine SND_DRQ
routine SND_IRQ (DB, CCB, PIX, LLA, ULA) : LINKAGE_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
CCB [C_PIX] = .PIX;
CCB [C_LIX] = .LLA;
CCB [C_FNC] = FC_XME;
CCB [C_MOD] = S$IRQ;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .ULA;
CCB [$SUB_FIELD (C_PRM1, 0, 8, 8, 0)] = 1;
LLCRS$ (.CCB);
end; !of routine SND_IRQ
routine SND_REJ (DB, CCB, PIX, LLA, ULA) : LINKAGE_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
bind
LINK = blockvector [.DB [D_ADDR], .ULA - 1, 0, 0, 0, 0; 0, L_LENGTH]
: block field (L_FIELDS);
LINK [ls_dip] = true;
CCB [C_PIX] = .PIX;
CCB [C_FNC] = FC_XME;
CCB [C_MOD] = S$REJ;
CCB [C_LIN] = .LLA;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .ULA;
CCB [C_PRM2] = S_ERBO;
LLCRS$ (.CCB);
end; !of routine SND_REJ
routine SND_SND (DB, CCB, PIX, LLA, ULA, EOM) : LINKAGE_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
CCB [C_PIX] = .PIX;
CCB [C_LIX] = .LLA;
CCB [C_FNC] = FC_XME;
CCB [C_MOD] = S$SND;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .ULA;
CCB [$SUB_FIELD (C_PRM1, 0, 8, 8, 0)] = .EOM;
LLCRS$ (.CCB);
end; !of routine SND_SND
routine SND_SNI (DB, CCB, PIX, LLA, ULA) : LINKAGE_DB_CCB novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
CCB [C_PIX] = .PIX;
CCB [C_LIX] = .LLA;
CCB [C_FNC] = FC_XME;
CCB [C_MOD] = S$SNI;
CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] = .ULA;
LLCRS$ (.CCB);
end; !of routine SND_SNI
routine PATTERN_CHECK (DB, CCB) : LINKAGE_DB_CCB =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
! None
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
begin
map
CCB : ref block field (C_FIELDS),
DB : ref block field (D_FIELDS);
bind
LINK = blockvector [.DB [D_ADDR], .CCB [$SUB_FIELD (C_PRM1, 0, 0, 8, 0)] - 1, 0, 0, 0, 0; 0, L_LENGTH]
: block field (L_FIELDS);
local
chr,
chr_ptr,
buff_ptr,
count;
count = .CCB[C_CNT];
buff_ptr = .CCB[C_ADDR];
chr_ptr = ch$ptr( chr);
if ((( .CCB[$sub_field( C_PRM1, byte_1)] and S$PBOM) neq 0) and
.LINK[L_TEST] eql 1) or
(.LINK[L_TEST] eql 3)
then
begin
buff_ptr = ch$plus( .CCB[C_ADDR], 4);
count = .count -4;
chr = %c'A';
end
else
chr = .LINK[L_PATTERN_CHARACTER];
While .count neq 0 do
begin
if ch$eql( 1, .chr_ptr, 1, .buff_ptr, 0)
then
begin
count = .count - 1;
buff_ptr = ch$plus( .buff_ptr, 1);
if .chr eql %c'Z'
then
chr = %c'0'
else
begin
if .chr eql %c'9'
then
chr = %c'A'
else
chr = .chr + 1;
end
end
else
return false;
end;
LINK[L_PATTERN_CHARACTER] = .chr;
return true;
end;
end
eludom