Google
 

Trailing-Edge - PDP-10 Archives - cuspmar86binsrc_2of2_bb-fp63a-sb - 10,7/dil/dilsrc/dapsub.bli
There are 21 other files named dapsub.bli in the archive. Click here to see a list.
MODULE DAPSUB(
	IDENT='6.0(6) 1-Mar-83'
        %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, 1985.
!  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:
!
! 	, : VERSION
! 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 Data
!
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(DD,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
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	Returns length of field
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BEGIN
MAP DD: REF $DAP_DESCRIPTOR;
MAP BV: REF BITVECTOR;
LOCAL
        BVEC: REF BITVECTOR,            ![5] Current word
        OFF,                            ! Current bit offset
	B;				! Most recent byte

BVEC=.BV;                               ![5] Point to start of bitvector
OFF=0;

INCR FLENGTH FROM 1 TO .MAXLEN DO
	BEGIN
        B=GET_BYTE(DD[$]);
        IF .OFF GEQ (%BPVAL-7)
        THEN
            BEGIN
            (.BVEC)<.OFF,%BPVAL-.OFF>=.B;       ![5] Wrap around byte
            BVEC=.BVEC+1;                       ! to next word
            OFF=7-(%BPVAL-.OFF);
            IF .OFF GTR 0 THEN (.BVEC)<0,.OFF>=.B<7-.OFF,.OFF>;
            END
        ELSE (.BVEC)<.OFF,7>=.B;        ![5]
        OFF=.OFF+7;
	IF (.B AND %O'200') EQL 0 THEN RETURN .FLENGTH;	!Extension bit off
	END;
DAP$_FTL					!Dap field too long
END;	!DAP$GET_BITVECTOR
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
CH$MOVE(.LEN,.ACP,.AZP);	!Copy that many characters
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(DD,BV,MAXLEN)=
BEGIN
!++
! 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)
!
!--
MAP DD: REF $DAP_DESCRIPTOR;

LOCAL BVEC;                             ![5]
LOCAL CNT;
LOCAL OFF;
LOCAL BYT;

OFF=0;
BVEC=.BV;                               ![5]

CNT=$DAP_SIZE_BITVECTOR[.BVEC,.MAXLEN]; ![5]

INCR I FROM 1 TO .CNT
DO  BEGIN
    IF .OFF GEQ (%BPVAL-7)
    THEN
        BEGIN
        BYT=.(.BVEC)<.OFF,%BPVAL-.OFF>; ![5] Wrap around byte
        BVEC=.BVEC+1;                   ! to next word
        OFF=7-(%BPVAL-.OFF);
        IF .OFF GTR 0 THEN BYT<7-.OFF,.OFF>=.(.BVEC)<0,.OFF>
        END
    ELSE
        BEGIN
        BYT=.(.BVEC)<.OFF,7>;           ![5]
        OFF=.OFF+7;
        END;

    BYT<7,1>=(.I NEQ .CNT);             ! Set extensable bit unless last
    PUT_BYTE(DD[$],.BYT);
    END;

.CNT
END;	!DAP$PUT_BITVECTOR
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(DD)=
!Get the DAP message header for the next message
!++
! FUNCTIONAL DESCRIPTION:
!
!	Get the DAP message header for the next message
!
! 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:
!
!	DAP Message header will have been read
!
!--
	BEGIN
        MAP DD: REF $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]=GET_BYTE(DD[$]);          !Message type

	DAP$GET_BITVECTOR(DD[$],DD[DAP$V_MFLAGS],5); !Message Flags

	IF .DD[DAP$V_MFLAGS_LENGTH]               !Length if present
	THEN DD[DAP$H_LENGTH]=GET_BYTE(DD[$]) +
                              (IF .DD[DAP$V_MFLAGS_LEN256]
                               THEN (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]
        THEN DD[DAP$H_BITCNT]=GET_BYTE(DD[$]);  ! Bit Count

	.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(DD): NOVALUE=
!Build the DAP message header for the next message
!++
! FUNCTIONAL DESCRIPTION:
!
!	Build the DAP message header for the next message
!
! FORMAL PARAMETERS:
!
!       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
        MAP DD: REF $DAP_DESCRIPTOR;

	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

        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_LENGTH]               !Length if present
	THEN PUT_BYTE(DD[$], .DD[DAP$H_LENGTH]);

        IF .DD[DAP$V_MFLAGS_LEN256]               ! Really long?
        THEN PUT_BYTE(DD[$], .DD[DAP$H_LENGTH]^-8);

        IF .DD[DAP$V_MFLAGS_BITCNT]               ! Bits left over?
        THEN 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]:                      ![4] Got interrupt message
               BEGIN
               0                        !? need to do this for FAL
               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