Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/dapsub.b36
There are 4 other files named dapsub.b36 in the archive. Click here to see a list.
MODULE DAPSUB(
IDENT='7.0(630) 11-Jun-86'
%BLISS36(,
ENTRY(
D$GEXT, ! DAP$GET_EXTENSABLE, ! extensable field -> EX str
D$GBIT, ! DAP$GET_BITVECTOR, ! extensable field -> bitvector
D$GVST, ! DAP$GET_VARIABLE_STRING, ! variable length -> asciz
D$GVCT, ! DAP$GET_VARIABLE_COUNTED,! variable-len -> var-len
D$PEXT, ! DAP$PUT_EXTENSABLE, ! EX str -> extensable field
D$PBIT, ! DAP$PUT_BITVECTOR, ! bitvector -> extensable field
D$SIZB, ! DAP$SIZE_BITVECTOR, ! # of bytes to send bitvector
D$GSTR, ! DAP$GET_STRING, ! rest of message -> descriptor
SETEXB, ! Turn on extension bits where needed
CHAZAC, ! Convert ASCIZ to ASCIC
CHACAZ, ! Convert ASCIC to ASCIZ
NUM_BV, ! number -> variable-length field
NUM_VB, ! variable-length -> number
D$PSTR, ! DAP$PUT_STRING, ! descriptor -> message
D$GHDR, ! DAP$GET_HEADER,! DAP message header -> DAP descr
D$UHDR, ! DAP$UNGET_HEADER,! Reverse effect of DAP$GET_HEADER
D$UBYT, !DAP$UNGET_BYTE, ! Put a byte back to reread later
DAP$EAT_MESSAGE, ! Gobble to the end of the message
D$PHDR, ! DAP$PUT_HEADER,! DAP Descr -> DAP message header
D$GBYT, ! DAP$GET_BYTE, ! Get a byte
D$PBYT, ! DAP$PUT_BYTE, ! Put a byte
D$G2BY, ! DAP$GET_2BYTE, ! Get 2 bytes
D$P2BY, ! DAP$PUT_2BYTE, ! Put 2 bytes
D$GLWD, ! DAP$GET_LONGWORD, ! variable field -> longword
D$PLWD, ! DAP$PUT_LONGWORD, ! longword -> variable field
D$GDTM, ! DAP$GET_DATE, ! Get date/time
D$PDTM, ! DAP$PUT_DATE, ! Put date/time
D$GMSG, ! DAP$GET_MESSAGE, ! Get a message from the net
D$PMSG ! DAP$PUT_MESSAGE ! Put a message to the net
))
)= BEGIN
!
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1986.
! ALL RIGHTS RESERVED.
!
! 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 THAT IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY: FTS-20 DAP Routines
!
! ABSTRACT: Routine to read a DAP message headers & fields
!
!
! ENVIRONMENT: XPN
!
! AUTHOR: Andrew Nourse, CREATION DATE: 22-Dec-81
!
! MODIFIED BY:
!
! 630 - Fix CHACAZ so it puts the null byte at end, not beginning.
! 566 - Handle interrupt messages properly
! 557 - Fix Multi-Stream
! 06 - Signal XPN failures (rather than letting XPN$_FAILURE blab on tty)
! 05 - Make DAP$GET_BITVECTOR handle long bitvectors correctly
! 04 - Handle reverse messages better
! 03 - Put in Entry points
! 02 - Routines to read/write dates
! 01 - The beginning
!--
!
! Library and Require Files
!
Library 'Dap';
Library 'Bli:Xport';
Library 'Blissnet';
Library 'Condit';
!
! Table of Contents
!
Forward Routine
dap$get_extensable, !get extensable field as ex field
dap$get_bitvector, !get extensable field as bit vector
dap$get_variable_string, !get variable length ascii field
dap$get_variable_counted, !get variable-len field including count
dap$put_extensable, ! put extensable field
dap$put_bitvector, !put a bitvector in message as extensable field
dap$size_bitvector, ! count lit bits in a bitvector, how many bytes needed
dap$get_string : novalue, ! get rest of message into string descriptor
setexb, ! turn on extension bits where needed
chazac, ! convert asciz to ascic
chacaz, ! convert ascic to asciz
num_bv:novalue, ! convert a number to a variable-length field
num_vb, ! convert a variable-length field to a number
dap$put_string : novalue, ! put string (possibly 8 bit bytes) in message
dap$get_header, ! get the dap message header for a new message
dap$unget_header, ! restore descriptor to state before we read header
dap$unget_byte: novalue,! put a byte back to reread later
dap$eat_message: novalue, ! gobble to the end of the message, ignore contents
dap$put_header: novalue, ! put the dap message header into the message
dap$get_byte, ! get a byte
dap$put_byte : novalue, ! put a byte
dap$get_2byte, ! get 2 bytes
dap$put_2byte : novalue, ! put 2 bytes
dap$get_longword, ! get longword (as variable field)
dap$put_longword : novalue, ! put longword (as variable field)
dap$get_date : novalue, ! get date/time
dap$put_date : novalue, ! put date/time
dap$get_message, ! get a message from the net
getdata : novalue, ! get data from msg into descr
dap$put_message; ! Put a message to the net
!
! Global Patchable Data. There is no impure OWN or GLOBAL storage.
!
PSECT GLOBAL=$HIGH$;
PSECT OWN=$HIGH$;
GLOBAL D$GTRACE: BITVECTOR[32]; ! Control tracing with this
BIND TRACE=D$GTRACE; ! Be reasonable
EXTERNAL ROUTINE
XPN$SIGNAL,
DAP$GET_STATUS,
D$TRACE;
GLOBAL ROUTINE DAP$GET_EXTENSABLE(DD,PTR,MAXLEN)=
!++
! FUNCTIONAL DESCRIPTION:
!
! Get an extensible field and write 8 bit bytes through PTR
!
! FORMAL PARAMETERS:
!
! DD: DAP Descriptor addr
! PTR: destination byte pointer
! MAXLEN: maximum number of bytes
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! Returns length of field
!
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MAP DD: REF $DAP_DESCRIPTOR;
LOCAL
B; !Most recent byte
INCR FLENGTH FROM 1 TO .MAXLEN DO
BEGIN
CH$WCHAR_A((B=GET_BYTE(DD[$])),PTR);
IF (.B AND %O'200') EQL 0 THEN RETURN .FLENGTH; !Extension bit off
END;
DAP$_FTL !Dap field too long
END; !DAP$GET_EXTENSABLE
GLOBAL ROUTINE Dap$Get_Bitvector ( p_dd, p_bv, maxlen )=
!++
! FUNCTIONAL DESCRIPTION:
!
! Get an extensible field and write bitvector
!
! FORMAL PARAMETERS:
!
! DD: DAP Descriptor addr
! BV: destination bit vector addr
! MAXLEN: maximum number of 8 bit bytes
!
! ROUTINE VALUE:
!
! Returns length of field
!
!--
BEGIN !m571vv
BIND dd=.p_dd: $Dap_Descriptor;
LOCAL
bvec: REF BITVECTOR, ! Current word
off, ! Current bit offset
b; ! Most recent byte
bvec=.p_bv; ! Point to start of bitvector
off=0;
INCR flength FROM 1 TO .maxlen DO
BEGIN
b=Dap$Get_Byte(dd); ! Get a byte
(.bvec)<.off,7>=.b; ! Store this byte
off=.off+7; ! Bump offset
IF .off GEQ %BPVAL ! If last byte didn't fit entirely
THEN
BEGIN
off=.off-%BPVAL; ! Back up the offset
bvec=.bvec+1; ! We will write the rest to next word
(.bvec)<0,.off>=.b<7-.off,.off>;
END;
IF (.b AND %O'200') EQL 0 THEN RETURN .flength; !Extension bit off
END;
Dap$_Ftl !Dap field too long
END; !Dap$Get_Bitvector !m571^^
GLOBAL ROUTINE DAP$GET_VARIABLE_STRING(DD,PTR,MAXLEN)=
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a variable-length field and write it starting where PTR points
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! MAXLEN: maximum number of bytes
! PTR: destination byte pointer
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! Length of field (excluding count)
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
LOCAL LEN;
MAP DD: REF $DAP_DESCRIPTOR;
IF (LEN=GET_BYTE(DD[$])) GTR .MAXLEN THEN RETURN DAP$_FTL;
DECR L FROM .LEN TO 1 DO
CH$WCHAR_A(GET_BYTE(DD[$]),PTR);
CH$WCHAR_A(0,PTR); !Make ASCIZ string
.LEN !Return length
END; !DAP$GET_VARIABLE_STRING
GLOBAL ROUTINE DAP$GET_VARIABLE_COUNTED(DD,PTR,MAXLEN)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a variable-length field and write it starting where PTR points
! identical to MGETVAR except that the count is also copied
! This should be used for binary fields
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! MAXLEN: maximum number of bytes
! PTR: destination byte pointer
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! length of field (excluding count)
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
LOCAL LEN;
IF (LEN=GET_BYTE(DD[$])) GTR .MAXLEN THEN RETURN DAP$_FTL;
CH$WCHAR_A(.LEN,PTR); !Copy the count first
DECR L FROM .LEN TO 1 DO
CH$WCHAR_A(GET_BYTE(DD[$]),PTR);
CH$WCHAR_A(0,PTR); !Make ASCIZ string
.LEN !Return length
END; !DAP$GET_VARIABLE_COUNTED
GLOBAL ROUTINE SETEXB(EXF,LEN)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Turn on extension bits if any trailing bits are on
!
! FORMAL PARAMETERS:
!
! EXF: Address of extensible field
! LEN: Length of extensible field in bytes
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! The extension bits in EXF are set where they should be
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! Number of bytes needed
!
! SIDE EFFECTS:
!
! NONE
!
!--
LOCAL B; !Highest bit that was on
LOCAL S; !Did we see any bits yet?
B=0;
S=0; !Haven't seen any bits on yet
DECR I FROM ((.LEN*8)-2) TO 7 DO BEGIN
MAP EXF: REF EX;
IF (.EXF[.I] AND (.S EQL 0)) THEN
BEGIN
B=.I; !Remember highest bit found
S=1; !Just saw one
END;
IF (.I AND 7) EQL 7 THEN EXF[.I]=.S;
!That was an extension bit, set it if necessary
END;
(.B/8)+1 !Return highest byte needed
END; !SETEXB
GLOBAL ROUTINE CHAZAC(AZP,ACP)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Convert ASCIZ string to ASCIC (counted ASCII) string
!
! FORMAL PARAMETERS:
!
! AZP: Byte pointer to ASCIZ string
! ACP: Byte pointer to where to store ASCIC string
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! length of string (excluding count)
!
! SIDE EFFECTS:
!
! NONE
!
!--
LOCAL ACLENP; !Pointer to length field
ACLENP=.ACP; !Length is stored in first position
CH$RCHAR_A(ACP); !Skip output pointer past where length will go
INCR LEN FROM 0 BY 1 DO
BEGIN
LOCAL C;
CH$WCHAR_A((C=CH$RCHAR_A(AZP)),ACP);
IF .C EQL 0 THEN
BEGIN
CH$WCHAR_A(.LEN,ACLENP); !Put length in first position
RETURN .LEN
END
END
END; !CHAZAC
GLOBAL ROUTINE CHACAZ(ACP,AZP)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Convert ASCIC string to ASCIZ string
!
! FORMAL PARAMETERS:
!
! ACP: Byte pointer to ASCIC string
! AZP: Byte pointer to where to store ASCIZ string
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! The string (converted) is stored thru AZP
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! Length of string (excluding null byte at end)
!
! SIDE EFFECTS:
!
! NONE
!
!--
LOCAL LEN;
LEN=CH$RCHAR_A(ACP); !Get length
AZP=CH$MOVE(.LEN,.ACP,.AZP); !Copy that many characters !630
CH$WCHAR_A(0,AZP); !Put null byte at end
.LEN !Return length
END; !CHACAZ
GLOBAL ROUTINE NUM_BV(VAR,NUM) :NOVALUE=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Convert an unsigned binary number
! into a DAP-format variable-length field.
! [Note that binary numbers are sent to DAP
! least significant byte first]
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! VAR: address of variable-length field
! NUM: value to convert
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
LOCAL PTR,
FPTR;
FPTR=CH$PTR(.VAR,0,8); !Pointer to length field
PTR=CH$PTR(.VAR,1,8); !Pointer to data portion
INCR I FROM 0 TO ((%BPVAL+7)/8)-1 DO
BEGIN
IF .NUM EQL 0 THEN (CH$WCHAR_A(.I,FPTR); !Write the length
RETURN);
CH$WCHAR_A(.NUM,PTR); !Write the next 8 bits worth
NUM=.NUM^(-8); !and shift it away
END
END; !NUM_BV
GLOBAL ROUTINE NUM_VB(VAR)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Convert a variable-length field into a binary number (unsigned)
!
! FORMAL PARAMETERS:
!
! VAR: address of variable-length field
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! Binary value
!
! SIDE EFFECTS:
!
! NONE
!
!--
LOCAL PTR,
NUM;
NUM=0;
PTR=CH$PTR(.VAR,0,8);
INCR I FROM 0 TO CH$RCHAR_A(PTR)-1 DO
BEGIN
NUM=.NUM+(CH$RCHAR_A(PTR)^(.I*8))
END;
.NUM
END; !NUM_VB
GLOBAL ROUTINE DAP$PUT_STRING(DD,DATADESC): NOVALUE=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a string of data from a descriptor into DAP message
! 8 bit bytes permissable
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! DATA: STRING to put
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! length of field (excluding count)
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
MAP DATADESC: REF $XPN_DESCRIPTOR();
LOCAL DESCPTR;
DESCPTR=.DATADESC[XPO$A_ADDRESS];
DECR I FROM .DATADESC[XPO$H_LENGTH]-1 TO 0
DO PUT_BYTE(DD[$],CH$RCHAR_A(DESCPTR));
END; !DAP$PUT_STRING
GLOBAL ROUTINE DAP$PUT_VARIABLE_STRING(DD,PTR): NOVALUE=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a string of ASCIZ data into DAP message
! 8 bit bytes permissable
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! PTR: Pointer to STRING to put
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! length of field (excluding count)
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
LOCAL LEN,
TPTR;
TPTR=.PTR;
LEN=0;
WHILE CH$RCHAR_A(TPTR) NEQ 0 DO LEN=.LEN+1; ! Count chars in string
DECR I FROM .LEN-1 TO 0
DO PUT_BYTE(DD[$],CH$RCHAR_A(PTR));
END; !DAP$PUT_VARIABLE_STRING
GLOBAL ROUTINE DAP$PUT_VARIABLE_COUNTED(DD,PTR) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a string of ASCIC data into DAP message
! 8 bit bytes permissable
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! PTR: Pointer to STRING to put
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! length of field (excluding count)
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
LOCAL LEN;
PUT_BYTE(DD[$],(LEN=CH$RCHAR_A(PTR))); ! Put the length field first
DECR I FROM .LEN-1 TO 0
DO PUT_BYTE(DD[$],CH$RCHAR_A(PTR));
END; !DAP$PUT_VARIABLE_COUNTED
GLOBAL ROUTINE DAP$PUT_EXTENSABLE(DD,EXF)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a string of bits in EXTENSABLE format into DAP message
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! EXF: FIELD to put
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! length of field (excluding count)
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
MAP EXF: REF EX;
LOCAL CNT;
LOCAL TPTR;
LOCAL BYT;
TPTR=CH$PTR(.EXF,0 %BLISS36(,9)); ! Point to extensable field
DO BEGIN
PUT_BYTE(DD[$],(BYT=CH$RCHAR_A(TPTR)));
CNT=.CNT+1;
END WHILE .BYT<7,1> NEQ 0; ! Keep it up until extensable bit off
.CNT
END; !DAP$PUT_EXTENSABLE
GLOBAL ROUTINE Dap$Put_Bitvector ( p_dd, p_bv, maxlen ) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a string of bits in EXTENSABLE format into DAP message
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! BV: Addr of bit vector
! MAXLEN: maximum number of bytes possible
!
! ROUTINE VALUE:
!
! length of field (excluding count)
!
!--
BEGIN !m571vv
BIND dd=.p_dd: $Dap_Descriptor;
LOCAL bvec,
cnt,
off,
byt;
off=0;
bvec=.p_bv; ![5]
cnt=$Dap_Size_Bitvector( .p_bv, .maxlen ); ![5]
INCR i FROM 1 TO .cnt
DO BEGIN
byt=.(.bvec)<.off,7>; ! Snarf up a byte
off=.off+7; ! Bump the offset for the next
IF .off GEQ %BPVAL ! Off the end of the word?
THEN
BEGIN
bvec=.bvec+1; ! to next word
off=.off-%BPVAL; ! back up offset into word
byt<7-.off,.off>=..bvec; ! Get the remaining bits we need
END;
byt<7,1>=(.i NEQ .cnt); ! Set extensable bit unless last
Dap$put_byte(dd,.byt);
END;
.cnt
END; !DAP$PUT_BITVECTOR !m571^^
GLOBAL ROUTINE DAP$SIZE_BITVECTOR(BVEC,MAXLEN,MINLEN)=
BEGIN
MAP BVEC: REF BITVECTOR;
LOCAL CNT;
CNT=.MINLEN; ! Must be at least 1
DECR I FROM (.MAXLEN*7)-1 TO 0 ! See how many bytes we need
DO IF .BVEC[.I] NEQ 0 THEN
BEGIN
CNT=(.I+7)/7;
EXITLOOP;
END;
.CNT
END; ! End of DAP$SIZE_BITVECTOR
GLOBAL ROUTINE DAP$GET_STRING(DD,DATADESC) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a string of data into a descriptor from DAP
! 8 bit bytes permissable
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! DATA: Where to put the data
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! length of field (excluding count)
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
MAP DATADESC: REF $XPN_DESCRIPTOR();
LOCAL DESCPTR;
DESCPTR=.DATADESC[XPO$A_ADDRESS];
DECR I FROM .DD[DAP$H_LENGTH]-1 TO 0
DO CH$WCHAR_A(GET_BYTE(DD[$]),DESCPTR);
END; !DAP$GET_STRING
GLOBAL ROUTINE Dap$Get_Header(p_dd)=
!Get the DAP message header for the next message
!++
! FUNCTIONAL DESCRIPTION:
!
! Get the DAP message header for the next message
!
! FORMAL PARAMETERS:
!
! P_DD: Addr of DAP header block
!
! IMPLICIT INPUTS:
!
! If no data in descriptor, DD[DAP$A_NLB] is used to find NLB
!
! IMPLICIT OUTPUTS:
!
! DD is set up
!
! ROUTINE VALUE:
!
! DAP message type.
!
! SIDE EFFECTS:
!
! DAP Message header will have been read
!
!--
BEGIN
BIND dd=.p_dd: $DAP_DESCRIPTOR;
LOCAL mflags;
IF .dd[Dap$h_Bytes_Remaining] LEQ 0 THEN Dap$Get_Message(dd);
!Get new buffer if needed
! Save position of start of message in case we need to back up
dd[Dap$h_Offset]=.dd[Dap$h_Bytes_Used];
dd[Dap$h_Length]=.dd[Dap$h_Bytes_Remaining];
dd[Dap$b_Operator]=Dap$Get_Byte(dd); !Message type
Dap$Get_Bitvector(dd,dd[Dap$v_Mflags],5); !Message Flags
IF .dd[Dap$v_Mflags_StreamId] ! StreamId !a557
THEN dd[Dap$b_StreamId]=Dap$Get_Byte(dd) ! if present
ELSE dd[Dap$b_StreamId]=0; ! default if absent
IF .dd[Dap$v_Mflags_Length] ! Length if present
THEN dd[Dap$h_Length]=Dap$Get_Byte(dd) +
(IF .dd[Dap$v_Mflags_Len256]
THEN (Dap$Get_Byte(dd)^8) ELSE 0) +
.dd[Dap$v_Mflags_Bitcnt];
! Length field, with high order byte if present
! add 1 byte for bit count if present
! since that is not supposed to be counted
! in the length (being part of the header)
IF .dd[Dap$v_Mflags_Bitcnt] ! Bit Count
THEN dd[Dap$h_Bitcnt]=Dap$Get_Byte(dd)
ELSE dd[Dap$h_Bitcnt]=0; !m556
.dd[Dap$b_Operator] !Returned as value
END; !End of DAP$GET_HEADER
GLOBAL ROUTINE DAP$UNGET_HEADER(DD)=
!++
! FUNCTIONAL DESCRIPTION:
!
! Backtrack so DAP$GET_HEADER gets same message over again
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP header block
!
! IMPLICIT INPUTS:
!
! If no data in descriptor, DD[DAP$A_NLB] is used to find NLB
!
! IMPLICIT OUTPUTS:
!
! DD is set up
!
! ROUTINE VALUE:
!
! DAP message type.
!
! SIDE EFFECTS:
!
! Current DAP Message will be read again on next DAP$GET_HEADER
!
!--
BEGIN
MAP DD: REF $DAP_DESCRIPTOR;
LOCAL BACKUP_COUNT;
! How far do we need to back up?
BACKUP_COUNT=.DD[DAP$H_BYTES_USED]-.DD[DAP$H_OFFSET];
! Restore position of start of message.
DD[DAP$H_BYTES_USED]=.DD[DAP$H_OFFSET];
DD[DAP$H_BYTES_REMAINING]=.DD[DAP$H_BYTES_REMAINING]+.BACKUP_COUNT;
DD[DAP$A_DATA]=CH$PLUS(.DD[DAP$A_DATA],-.BACKUP_COUNT);
DD[DAP$H_LENGTH]=.DD[DAP$H_BYTES_REMAINING];
.DD[DAP$B_OPERATOR] !Returned as value
END; !End of DAP$UNGET_HEADER
GLOBAL ROUTINE DAP$UNGET_BYTE(DD): NOVALUE=
!++
! FUNCTIONAL DESCRIPTION:
!
! Backtrack 1 byte so DAP$GET_BYTE gets same byte over again
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP header block
!
! IMPLICIT INPUTS:
!
! If no data in descriptor, DD[DAP$A_NLB] is used to find NLB
!
!--
BEGIN
MAP DD: REF $DAP_DESCRIPTOR;
! Back everything up 1 byte
DD[DAP$H_BYTES_USED]=.DD[DAP$H_BYTES_USED]-1;
DD[DAP$H_BYTES_REMAINING]=.DD[DAP$H_BYTES_REMAINING]+1;
DD[DAP$A_DATA]=CH$PLUS(.DD[DAP$A_DATA],-1);
DD[DAP$H_LENGTH]=.DD[DAP$H_LENGTH]+1;
END; !End of DAP$UNGET_BYTE
GLOBAL ROUTINE DAP$EAT_MESSAGE(DD): NOVALUE=
!++
! FUNCTIONAL DESCRIPTION:
!
! Ignore rest of message, be ready to read next message
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP header block
!
!--
BEGIN
MAP DD: REF $DAP_DESCRIPTOR;
WHILE .DD[DAP$H_LENGTH] GTR 0
DO DAP$GET_BYTE(DD[$]);
END; !End of DAP$EAT_MESSAGE
GLOBAL ROUTINE Dap$Put_Header( P_dd ): NOVALUE=
!Build the DAP message header for the next message
!++
! FUNCTIONAL DESCRIPTION:
!
! Build the DAP message header for the next message
!
! FORMAL PARAMETERS:
!
! P_DD: Addr of DAP header block
!
! IMPLICIT INPUTS:
!
! NLB attached to DD will be used for output if necessary.
!
! SIDE EFFECTS:
!
! If new message won't fit (as determined by info in DD)
! then the current contents of the buffer are output first
!--
BEGIN
BIND dd=.P_dd: $Dap_Descriptor;
IF .dd[Dap$b_StreamId] NEQ 0 !a557
THEN dd[Dap$v_Mflags_StreamId] = 1;
IF .dd[Dap$h_Bytes_Remaining] LEQ (.dd[Dap$h_Length]+5)
THEN Dap$Put_Message(dd);
!Output buffer if new message won't fit
Dap$Put_Byte(dd,.dd[Dap$b_Operator]); !Message type
IF (.dd[Dap$h_Length] GTR 255) !need to set len256?
AND .dd[Dap$v_Mflags_Length]
THEN Dd[Dap$v_Mflags_Len256]=1;
Dap$Put_Bitvector(dd,Dd[Dap$v_Mflags],6); !Message Flags
IF .dd[Dap$v_Mflags_StreamId] ! Stream ID !a557
THEN Dap$Put_Byte(dd, .dd[Dap$b_StreamId]);
IF .dd[Dap$v_Mflags_Length] !Length if present
THEN Dap$Put_Byte(dd, .dd[Dap$h_Length]);
IF .dd[Dap$v_Mflags_Len256] ! Really long?
THEN Dap$Put_Byte(dd, .dd[Dap$h_Length]^-8);
IF .dd[Dap$v_Mflags_Bitcnt] ! Bits left over?
THEN Dap$Put_Byte(dd,.dd[Dap$h_Bitcnt]);
END; !End of DAP$PUT_HEADER
GLOBAL ROUTINE DAP$GET_BYTE(DD)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a byte
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! The byte gotten, or -1 if message is empty
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
IF .DD[DAP$H_LENGTH] LEQ 0
THEN (IF .DD[DAP$V_MFLAGS_MORE]
THEN GET_HEADER(DD[$])
ELSE RETURN -1);
DD[DAP$H_LENGTH]=.DD[DAP$H_LENGTH]-1; ! Decr DAP length
DD[DAP$H_BYTES_REMAINING]=.DD[DAP$H_BYTES_REMAINING]-1; ! And bytes left
DD[DAP$H_BYTES_USED]=.DD[DAP$H_BYTES_USED]+1; ! Incr bytes eaten
CH$RCHAR_A(DD[DAP$A_DATA]) ! Finally read the byte
END; !DAP$GET_BYTE
GLOBAL ROUTINE DAP$PUT_BYTE(DD,DATA) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a byte of data into a descriptor
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! DATA: Byte to put
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! length of field (excluding count)
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
LOCAL LEN;
DD[DAP$H_BYTES_USED]=.DD[DAP$H_BYTES_USED]+1;
DD[DAP$H_BYTES_REMAINING]=.DD[DAP$H_BYTES_REMAINING]-1;
CH$WCHAR_A(.DATA,DD[DAP$A_DATA]); !Copy the count first
END; !DAP$PUT_BYTE
GLOBAL ROUTINE DAP$GET_2BYTE(DD)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Get 2 bytes
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! The byte gotten, or -1 if message is empty
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
GET_BYTE(DD[$])+(GET_BYTE(DD[$])^8)
END; !DAP$GET_2BYTE
GLOBAL ROUTINE DAP$PUT_2BYTE(DD,DATA): NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Put 2 bytes of data into a descriptor
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! DATA: Value to put
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
!
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
PUT_BYTE(DD[$],.DATA);
PUT_BYTE(DD[$],(.DATA)^-8);
END; !DAP$PUT_2BYTE
GLOBAL ROUTINE DAP$GET_LONGWORD(DD)=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a longword (4 bytes) of binary data
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! The value gotten
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
LOCAL LEN,
VALUE;
VALUE=0;
LEN=GET_BYTE(DD[$]);
INCR I FROM 0 TO .LEN-1
DO
BEGIN
IF .VALUE<%BPVAL-8,8> NEQ 0 ! Check for overflow about to happen
THEN SIGNAL (DAP$_FTL,0,DD[$]); ! It did. This way allows lots of
VALUE=.VALUE+(GET_BYTE(DD[$])^(.I*8)); ! leading zeroes without error
IF .VALUE LSS 0
THEN SIGNAL (DAP$_FTL,0,DD[$]); ! If sign flipped, we overflowed too.
END;
.VALUE
END; !DAP$GET_LONGWORD
GLOBAL ROUTINE DAP$PUT_LONGWORD(DD,DATA) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a byte of data into a descriptor as variable field
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! DATA: Value to put
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! length of field (excluding count)
!
! SIDE EFFECTS:
!
! NONE
!
!--
MAP DD: REF $DAP_DESCRIPTOR;
LOCAL LEN;
LEN=4; ! For now
PUT_BYTE(DD[$],.LEN);
DECR I FROM .LEN-1 TO 0 ! Put the least signif first
DO (PUT_BYTE(DD[$],.DATA);
DATA=.DATA^-8);
END; !DAP$PUT_LONGWORD
GLOBAL ROUTINE DAP$GET_DATE(DD: REF $DAP_DESCRIPTOR,PTR) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a Date from a message (18 bytes, ASCII)
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! PTR: thru which to write date
!
!--
BEGIN ! Read a date/time (18 ascii bytes)
DECR I FROM 17 TO 0
DO CH$WCHAR_A(DAP$GET_BYTE(DD[$]),PTR);
END;
GLOBAL ROUTINE DAP$PUT_DATE(DD: REF $DAP_DESCRIPTOR,PTR) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a Date into a message (18 bytes, ASCII)
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
! PTR: thru which to read date
!
!--
BEGIN ! Put a date/time (18 ascii bytes)
DECR I FROM 17 TO 0
DO DAP$PUT_BYTE(DD[$],CH$RCHAR_A(PTR));
END;
GLOBAL ROUTINE DAP$GET_MESSAGE(DD) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a message from remote system
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
!
! COMPLETION CODES:
!
! Success/Failure code returned by BLISSNET
!
!--
BEGIN
LOCAL R;
MAP DD: REF $DAP_DESCRIPTOR;
BIND NLB=.DD[DAP$A_NLB]: $XPN_NLB();
R = $XPN_GET(NLB=NLB, OPTION=WAIT, FAILURE=XPN$SIGNAL); ! Get message
GETDATA(DD[$]);
.R
END;
ROUTINE GETDATA (DD: REF $DAP_DESCRIPTOR): NOVALUE =
BEGIN
BIND NLB=.DD[DAP$A_NLB]: $XPN_NLB();
$XPN_DESC_INIT(DESCRIPTOR=DD[DAP$T_DATA],CLASS=BOUNDED); ! Point to it
DD[DAP$A_DATA]=.NLB[NLB$A_STRING]; !
DD[DAP$H_BYTES_REMAINING]=DD[DAP$H_MESSAGE_LENGTH]=.NLB[NLB$H_BYTES];
! Trace if requested
IF .D$GTRACE LSS 0 THEN D$TRACE(DD[$],DAP$K_TRACE_INPUT);
END;
GLOBAL ROUTINE DAP$PUT_MESSAGE(DD) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a message to remote system
!
! FORMAL PARAMETERS:
!
! DD: Addr of DAP descriptor
!
! COMPLETION CODES:
!
! Success/Failure code returned by BLISSNET
!
!--
BEGIN
LOCAL R;
MAP DD: REF $DAP_DESCRIPTOR; ! Message descriptor (bounded)
! data is in prefix
BIND OTHER_DD=.DD[DAP$A_OTHER_DD]: $DAP_DESCRIPTOR;
IF (OTHER_DD NEQ 0)
AND (.OTHER_DD[DAP$H_BYTES_REMAINING] EQL 0) ![4] Check for
THEN ![4] reverse traffic
BEGIN ![4]
BIND NLB=.DD[DAP$A_NLB]: $XPN_NLB();
IF .NLB[NLB$V_DATA_REQ] EQL 0 ![4] Is a read posted?
THEN $XPN_GET(NLB=NLB, ![4] No. post one.
FAILURE=XPN$SIGNAL); ![6] Signal failure if any
SELECT $XPN_EVENT_INFO(NLB=NLB, FAILURE=XPN$SIGNAL) OF ![6]
SET
[XPN$_INTERRUPT]: ! Got interrupt message !M566
BEGIN
$XPN_GET( NLB=NLB, TYPE=INTERRUPT, ! So get it
FAILURE=XPN$SIGNAL ); !
%( Ignore for now
$XPN_DESC_INIT(DESCRIPTOR=Other_DD[Dap$t_Data],
CLASS=BOUNDED); ! Set up descriptor pointing
Other_Dd[Dap$a_Data]=.Nlb[Nlb$a_Interrupt]; ! to interrupt msg
Other_Dd[Dap$h_Bytes_Remaining]
= Other_Dd[Dap$h_Message_Length]
= .Nlb[Nlb$h_Interrupt];
)%
! Trace if requested
IF .D$Gtrace LSS 0 THEN D$Trace(Other_Dd,
Dap$k_Trace_Input_Interrupt);
END;
[XPN$_DATA]: ![4] got data message
BEGIN
GETDATA(OTHER_DD[$]); ![4] make descr point to data
IF DAP$GET_HEADER(OTHER_DD[$]) EQL DAP$K_STATUS
THEN
BEGIN
SIGNAL(DAP$GET_STATUS(OTHER_DD[$]))
END
ELSE DAP$UNGET_HEADER(OTHER_DD[$])
END;
TES;
END; ![4]
DD[DAP$H_BYTES_REMAINING]=.DD[DAP$H_BYTES_USED]; !Make descr point
DD[DAP$H_BYTES_USED]=0; !to data in message
DD[DAP$A_DATA]=CH$PLUS(.DD[DAP$A_DATA],-.DD[DAP$H_BYTES_REMAINING]);
! Trace message if requested
IF .D$GTRACE LSS 0 THEN D$TRACE(DD[$],DAP$K_TRACE_OUTPUT);
IF .DD[DAP$V_INTERRUPT]
THEN
BEGIN
R=$XPN_PUT(NLB=.DD[DAP$A_NLB],STRING=DD[DAP$T_DATA],
OPTION=END_OF_MESSAGE, FAILURE=XPN$SIGNAL,
TYPE=INTERRUPT);
DD[DAP$V_INTERRUPT]=0;
END
ELSE
R=$XPN_PUT(NLB=.DD[DAP$A_NLB],STRING=DD[DAP$T_DATA],
OPTION=END_OF_MESSAGE, TYPE=DATA, FAILURE=XPN$SIGNAL);
DD[DAP$H_BYTES_REMAINING]=.DD[DAP$H_MESSAGE_LENGTH];
.R
END;
END ELUDOM