Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE DAP=	!TEMPORARY VERSION TO AVOID INCOMPATABILITY WITH V1E
!DAP message processing routines
!Author: Andrew Nourse
BEGIN

!
! Table of Contents
!
FORWARD ROUTINE
MGETEX,			!Get extensible field
MGETVAR,		!Get variable length field (convert to ASCIZ)
MGETVC,			!Get variable-length field including count
GETCFG,			!Get Config message
DOAA,			!Get Attributes or Access
DOCTL,			!Get control message
SNDATT,			!Build ATTRIBUTES from fileblock & send it
SNDACC,			!Build & send ACCESS message
SNDNAM,			!Build & send a NAME message
SNDCTL,			!Build & send CONTROL message
SETEXB,			!Turn on extension bits where needed
CHAZAC,			!Convert ASCIZ to ASCIC
CHACAZ,			!Convert ASCIC to ASCIZ
NUM_BV,			!Convert a number to a variable-length field
NUM_VB,			!Convert a variable-length field to a number
DOSTS,			!Process a STATUS message
DOACM;			!Process an ACCESS COMPLETE message

!
! Require files & libraries
!

REQUIRE 'INTR.REQ';	!Require file for NETSPL-10/20
LIBRARY 'DAPLIB';		!DAP library file

!
! Conditionals
!


!
! External routines used
!

EXTERNAL ROUTINE
OUTPUT,		!Write out a buffer
BIN,		!Read a byte
BOUT,		!Write a byte
COPY,		!Copy some data (word mode)
TELLJOB,	!Job start or finish messages
UNWIND,		!Remove some routine calls from the stack
DTM_DS,		!Convert date & time to internal format
DTM_SD,		!Convert internal date & time to DAP format
DAT_DS,		!Convert datatype to internal format
DAT_SD,		!convert internal representation of datatype to DAP format
ALLOC,		!Core giver
FPARSE,		!Filespec parser
PRO_DS,		!Convert DAP format protection code to system format
PRO_SD,		!Convert protection from internal format to DAP format
XINPUT,		!Input a buffer from network
XBIN,		!Get byte from message
XBOUT,		!Put byte into message
XSOUT,		!Put string into message
XMTMSG,		!Send a message
ACCESS,		!Network file protection routine
XOUTPUT,	!Force out everything in buffer
!ZERO,		!Clear some memory
FBINIS,		!Set up file block, but don't set up defaults
RECV,		!Get data & put it in a file
XMIT,		!Put file data out the network
RELEASE;	!Flush the file open on this channel (if any) & free channel
%IF FTTOPS10 %THEN
EXTERNAL ROUTINE
FIXIMG;		!Don't add extra word to file in Image Mode
%FI;

EXTERNAL
	RUN;	!Current process block

THIS_IS [DAP]	VERSION [52] VMINOR ['F']	EDIT [27] DATE[11,DEC,79]
!This implements DAP 5.2

!
! Revision History
!
%(
[27]	Set SOFTVER to 3; Fix DAP_PRO, DAP_DTM and DAP_NAM in NETCOM
[26]	Don't get upset about SYNC error on STATUS message
[25]	Put image-mode fix into FIXIMG (in NETIO), make DOACM call it
	Set FB$BIO in ACCESS msg, RAC & KRF in CONTROL message
[24]	Correctly handle short STATUS message in new routine DOSTS
[23]	Make ACCESS COMPLETE work during transfer in new routine DOACM
[22]	Remove NET33COMPAT Kludge (breaks 10-to-11 and no longer needed)
[21]	Set SOFTVER=2 (in CONFIG msg) for new USERID format
[20]	Set up reasonable defaults for protection
[17]	Fix sending of protection message
[16]	Put menus in Protection & Date&time messages
[15]	Use byte mode all the time, move XMIT & RECV to module XFER
[13]	Bring into accordance with DAP 4.1, put in some 4.2 stuff
)%

!
! Macros
!

MACRO V1ECOMPAT[]=%REMAINING %;	!Support old -10 version with
					!incorrect DTM PRO and NAME msgs
MACRO IFV1E(THENARG,ELSEARG)=
	(LITERAL OS_TOPS10=9;
	 IF (.NB[NDB$SOFTVER] LSS 3)
	 AND (.NB[NDB$OSTYPE] EQL OS_TOPS10)
	 THEN (THENARG) ELSE (ELSEARG)) %;



MACRO NOTV5=(.N[VERNUM] LEQ 4) %;
MACRO V5=(.N[VERNUM] GEQ 5) %;
MACRO NORMS[]=(%REMAINING) %;
MACRO RMS[]= () %;	!No RMS yet

!
! Global PLITS
!

GLOBAL BIND	CFGMSG=PLIT(CHAR8(
				DAP_CFG,	!Message type CONFIG
				1^MFLAGS_LENGTH,	!Flags (length field present)
				14,		!Length field
				0,0,		!Buffer size = infinite
				9,		!Operating system: TOPS-10
				6,		!File system type: none
				5,		!DAP version 5
				0,		!ECO #  (DAP 5.0)
				0,		!Customer version #
				3,		!Release 3 of software
				0,		!User software ver #
				!SYSCAP fields follow
				%O'243',%O'200',%O'260',%O'340',%O'10'
						!Preallocation
						!Sequential organization
						!Sequential access
						!DAP message blocking
						!Blocking across responses
						!DTM attr. ext. msg
						!PROT attr. ext. msg
						!Delete via FOP field
			)):BYTE8VECTOR;

GLOBAL BIND CFGLEN=17;
BIND ACK_MESSAGE=PLIT(CHAR8(DAP_ACK,0));
		!Acknowledge
BIND ACCOMP_RESP=PLIT(CHAR8(DAP_ACM,0,ACM_RSP));
BIND ACCOMP_RESP_LEN=3;
BIND RMTERRS=UPLIT(RMTERR);

GLOBAL ROUTINE MGETEX(NB,PTR,MAXLEN)=
!Get an extensible field and write 8 bit bytes through PTR
!Arguments:
!	NB:	node data block
!	PTR:	destination byte pointer
!	MAXLEN:	maximum number of bytes
!Returns length of field
BEGIN
LOCAL
	B;				!Most recent byte

INCR FLENGTH FROM 1 TO .MAXLEN DO
	BEGIN
	CH$WCHAR_A((B=GET_BYTE),PTR);
	IF (.B AND %O'200') EQL 0 THEN RETURN .FLENGTH;	!Extension bit off
	END;
DAPFTL					!Dap field too long
END;	!MGETEX

GLOBAL ROUTINE MGETVAR(NB,MAXLEN,PTR)=
!Get a variable-length field and write it starting where PTR points
!ARGS:
!	NB:	node data block
!	MAXLEN:	maximum number of bytes
!	PTR:	destination byte pointer
!Returns: length of field (excluding count)
BEGIN
MAP NB: REF NDB;
LOCAL LEN;
IF (LEN=GET_BYTE) GTR .MAXLEN THEN RETURN DAPFTL;
DECR L FROM .LEN TO 1 DO
	CH$WCHAR_A(GET_BYTE,PTR);
CH$WCHAR_A(0,PTR);	!Make ASCIZ string
.LEN	!Return length
END;	!MGETVAR

GLOBAL ROUTINE MGETVC(NB,MAXLEN,PTR)=
!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
!ARGS:
!	NB:	node data block
!	MAXLEN:	maximum number of bytes
!	PTR:	destination byte pointer
!Returns: length of field (excluding count)
BEGIN
MAP NB: REF NDB;
LOCAL LEN;
IF (LEN=GET_BYTE) GTR .MAXLEN THEN RETURN DAPFTL;

CH$WCHAR_A(.LEN,PTR);	!Copy the count first

DECR L FROM .LEN TO 1 DO
	CH$WCHAR_A(GET_BYTE,PTR);
CH$WCHAR_A(0,PTR);	!Make ASCIZ string
.LEN	!Return length
END;	!MGETVC

GLOBAL ROUTINE GETCFG(NB)=
!Routine to receive a CONFIG message and save the information contained
!therein.
!PARAMETER:	NB:	A NODE DATA BLOCK
!RETURNS:	DAP_CFG (1) if successful,
	BEGIN				!We are expecting a CONFIG message
	LOCAL MTYPE;			!DAP message type
	MAP NB: REF NDB;
	GET_HDR;			!First byte of message is TYPE field
	IF .MTYPE EQL DAP_CFG THEN
		BEGIN	!Fill in the info from this message
		N[BUFSIZ]=GET_2BYTE;	!Maximum DAP message size
		N[OSTYPE]=GET_BYTE;	!What are we talking to
		N[FILESYS]=GET_BYTE;	!File system type
		N[VERNUM]=GET_BYTE;	!DAP Version # of remote system
		N[ECONUM]=GET_BYTE;	!DAP ECO #
		N[USRNUM]=GET_BYTE;	!Customer version # for DAP
		N[SOFTVER]=GET_BYTE;	!Version of cusp i.e. NETSPL or FAL
		N[USRSOFT]=GET_BYTE;	!User cusp version #
		GETEX(N[SYSCAP],12);	!SYSCAP bits
					!Message was longer than it should be
		N[GOT_CFG]=1;		!Remember we got it
		DAP_CFG			!Return what we got
		END
	ELSE
		BEGIN
		SEND_STATUS(MAC$SYNC,DAP_CFG);
		END
	END;				!End of GETCFG

GLOBAL ROUTINE DOAA(NB)=
!Routine to get an ATTRIBUTES and/or ACCESS message & save the data therein.
!ARGUMENT: NB: a NODE data block
!RETURNS:  WIN if successful, DAP error code otherwise
BEGIN				!Expecting ATTRIBUTES or ACCESS
					!or any of the Attributes extensions
MAP NB: REF NDB;
LOCAL MTYPE;			!DAP message type
LOCAL WAIT_FOR_NAME;		!Remember to wait for NAME message(s)
				!on new-format RENAME
BIND FB=.N[FB]: FILE_BLOCK;	!File block for local side of transfer

CLEARV(WAIT_FOR_NAME);	!Initially zero
WHILE 1 DO
	BEGIN
	GET_HDR;
	SELECT .MTYPE OF SET

	[DAP_ATT]:
		BEGIN
		LOCAL ATTMENU: EX[6];	!Extensible field

		CLEARV(ATTMENU);	!Turn off all bits to start
		GETEX(ATTMENU,6);	!Attributes menu bits
		IF .ATTMENU[ATT_DAT] THEN GETEX(N[DATATYPE],2)
					ELSE EX[N[DATATYPE],DAT$IMA]=1;
					!Default is image mode
		DAT_DS(.NB,N[DATATYPE]); !Either way, set it up in the filblk

		IF .ATTMENU[ATT_ORG] THEN N[ORG]=GET_BYTE;
		IF .ATTMENU[ATT_RFM] THEN N[RFM]=GET_BYTE;
		IF .ATTMENU[ATT_RAT] THEN GETEX(N[RAT],3);
		IF .ATTMENU[ATT_BLS] THEN N[BLS]=GET_2BYTE;
		IF .ATTMENU[ATT_MRS] THEN N[MRS]=GET_2BYTE;
		IF .ATTMENU[ATT_ALQ] THEN
			BEGIN
			LOCAL ALQ: BYTE8VECTOR[6];
			CLEARV(ALQ);
			GETVC(ALQ,5);	!Get the variable-length field
			TOPS10<
			F[ALLOC]=0;	!Don't try for contiguous yet
			F[EST]=NUM_VB(ALQ)	!and convert it to binary
			>
			END;
		IF .ATTMENU[ATT_BKS] THEN
			BEGIN
			IF GET_BYTE NEQ 0 THEN
				SEND_STATUS(MAC$UNSUPPORT,MIC$ATT+MIC$F30)
			END;
		IF .ATTMENU[ATT_FSZ] THEN
			BEGIN
			IF GET_BYTE NEQ 0 THEN
				SEND_STATUS(MAC$UNSUPPORT,MIC$ATT+MIC$F31)
			END;
		IF .ATTMENU[ATT_MRN] THEN
			BEGIN
			LOCAL MRN: BYTE8VECTOR[9];
			GETVC(MRN,5);
			!ignore it for now
			END;
		IF .ATTMENU[ATT_RUN] THEN BEGIN
			LOCAL RTS: VECTOR[CH$ALLOCATION(40)];
			GETVAR(RTS,40,CH$SIZE());
			TOPS10<(EXTERNAL ROUTINE RDSIXA;
				F[SPOOL]=RDSIXA(%REF(CH$PTR(RTS))))>
			!RTS stored in spooled name for TOPS-10
			END;
		IF .ATTMENU[ATT_DEQ] THEN
			BEGIN
			GET_2BYTE;	!Eat it
			END;
		IF .ATTMENU[ATT_FOP] THEN GETEX(N[FOP],6);
		IF .ATTMENU[ATT_BSZ] THEN N[BSZ]=GET_BYTE;	!Byte size
		IF .ATTMENU[ATT_DEV] THEN GETEX(N[DEV],6);	!Device characteristics
		IF .ATTMENU[ATT_SDC] THEN BEGIN
			LOCAL T:VECTOR[2];
			GETEX(T,6);	
			END;		!Ignore spooling device characteristics
%(			!This is not the way they decided to do it!!
		IF .ATTMENU[ATT_DATE] THEN BEGIN
			LOCAL TDATE,TTIME;	!Temps for date & time
			LOCAL DTMSTR: VECTOR[CH$ALLOCATION(18)];

			GET_18BYTE(DTMSTR);
			DTM_DS(DTMSTR,TDATE,TTIME); 
			F[CDATE]=.TDATE;
			F[CTIME]=.TTIME;
			TOPS10< F[CDATE75]=.TDATE<12,3>;> !DATE75 for TOPS10

			GET_18BYTE(DTMSTR);
			DTM_DS(DTMSTR,TDATE,TTIME); 
			F[ADATE]=.TDATE;
			%IF %DECLARED(FILE$ATIME)
				%THEN F[ATIME]=.TTIME; %FI

			GET_18BYTE(DTMSTR);		!Get scratch date
			DTM_DS(DTMSTR,TDATE,TTIME);	!convert
			%IF %DECLARED(FILE$DDATE)
				%THEN F[DDATE]=.TDATE; %FI
			%IF %DECLARED(FILE$DTIME)
				%THEN F[DTIME]=.TTIME; %FI
			END;
		IF .ATTMENU[ATT_OWN] THEN BEGIN
			LOCAL T;
			LOCAL OWNER: VECTOR[CH$ALLOCATION(40)];
			GETVAR(OWNER,40);
			T=0;		!Default is everything
			GETEX(T,3);	!System protection
			%IF %DECLARED(FILE$PROTSYS)
				%THEN F[PROTSYS]=PRO_DS(.T); %FI
			T=0;		!Default is everything
			GETEX(T,3);	!Owner protection
			F[PROTOWN]=PRO_DS(.T);
			T=0;		!Default is everything
			GETEX(T,3);	!Group protection
			F[PROTGRP]=PRO_DS(.T);
			T=0;		!Default is everything
			GETEX(T,3);	!World protection
			F[PROTWLD]=PRO_DS(.T);
			END;
)%
		N[GOT_ATT]=1;		!Remember we got it
		END;
	[DAP_DTM V1ECOMPAT(,15)]:		!Date & time extension message
		V1ECOMPAT(IF NOT .NB[NDB$GOT_ACC] THEN)
		BEGIN
		LOCAL TDATE,TTIME;	!Temps for date & time
		LOCAL DTMSTR: VECTOR[CH$ALLOCATION(18)];
		LOCAL DTMMENU: EX[2];	!Menu for this message
		CLEARV (DTMMENU);

		GETEX(DTMMENU,2);

		IF .DTMMENU[DTM_CDT]
		THEN	BEGIN
			GET_18BYTE(DTMSTR);
			DTM_DS(DTMSTR,TDATE,TTIME); 
			F[CDATE]=.TDATE;
			F[CTIME]=.TTIME;
			TOPS10< F[CDATE75]=.TDATE<12,3>;> !DATE75 for TOPS10
			END;

		IF .DTMMENU[DTM_RDT]
		THEN	BEGIN
			GET_18BYTE(DTMSTR);
			DTM_DS(DTMSTR,TDATE,TTIME); 
			F[ADATE]=.TDATE;
			%IF %DECLARED(FILE$ATIME)
			%THEN F[ATIME]=.TTIME; %FI
			END;

		IF .DTMMENU[DTM_EDT]
		THEN	BEGIN
			GET_18BYTE(DTMSTR);		!Get scratch date
			DTM_DS(DTMSTR,TDATE,TTIME);	!convert
			%IF %DECLARED(FILE$DDATE)
			%THEN F[DDATE]=.TDATE; %FI
			%IF %DECLARED(FILE$DTIME)
			%THEN F[DTIME]=.TTIME; %FI
			END;
		END;
	[DAP_PRO V1ECOMPAT(,16)]:		!Protection extension message
		BEGIN
		LOCAL T;
		LOCAL PROMENU: EX[2];	!Menu of protection message fields
		LOCAL OWNER: VECTOR[CH$ALLOCATION(40)];
		CLEARV(PROMENU);
		GETEX(PROMENU,2);	!Get the menu

		IF .PROMENU[PRO_OWNER]
		THEN	GETVAR(OWNER,40);

		T=DEF_PRO_SYS;		!Default
		IF .PROMENU[PRO_PROTSYS]
		THEN	(T=0;GETEX(T,3));	!System protection
		%IF %DECLARED(FILE$PROTSYS)
		%THEN F[PROTSYS]=PRO_DS(.T); %FI

		T=DEF_PRO_OWN;		!Default
		IF .PROMENU[PRO_PROTOWN]
		THEN	(T=0;GETEX(T,3));	!Owner protection
		F[PROTOWN]=PRO_DS(.T);

		T=DEF_PRO_GRP;		!Default
		IF .PROMENU[PRO_PROTGRP]
		THEN	(T=0;GETEX(T,3));	!Group protection
		F[PROTGRP]=PRO_DS(.T);

		T=DEF_PRO_WLD;		!Default
		IF .PROMENU[PRO_PROTWLD]
		THEN	(T=0;GETEX(T,3));	!World protection
		F[PROTWLD]=PRO_DS(.T);
		END;
	[DAP_NAM V1ECOMPAT(,17)]:
		V1ECOMPAT(IF .NB[NDB$GOT_ACC] THEN)
		BEGIN
		LOCAL FILESPEC: VECTOR[CH$ALLOCATION(200)];	!Store filespec
		LOCAL NAMETYPE:EX[3];
		LOCAL F2: REF FILE_BLOCK;
		EXTERNAL ROUTINE ZERO;

		GETEX(NAMETYPE,3);

		IF .N[ACCFUNC] EQL ACC$RENAME
		THEN	BEGIN		!This is for a new name
			IF .N[RENAME_FB] EQL 0	!Make rename FB if none around yet
			THEN	N[RENAME_FB]=(F2=ALLOC(FB_LEN)); !Allocate another fb
			COPY(FB[FILE$START],F2[FILE$START],FB_LEN);
			!Copy the whole file block
			FB[FILE$RENAME]=.F2[FILE$LOOKUP];
			END;
		FBINIS(F2[FILE$START]);	!Set up, but don't clobber defaults
		GETVAR(FILESPEC,200,CH$SIZE()); !copy into temp
		IF (FPARSE(F2[FILE$START],%REF(CH$PTR(FILESPEC)))) NEQ WIN THEN
			BEGIN
			SEND_STATUS(MAC$OPEN,ER$FNM);
			END;

		!We're done unless this is a default or related filespec
		IF (.NAMETYPE[NT$DEF] OR .NAMETYPE[NT$REL]) EQL 0
		THEN	BEGIN
			ACCESS(NB[FILE$START]);	!Try to rename the file
			RETURN DAP_NAM;		!end of setup sequence
			END;
		END;
	[DAP_ACC]:
		BEGIN
		LOCAL FILESPEC: VECTOR[CH$ALLOCATION(200)];
		LOCAL	DISPLAY: EX[4],	!DISPLAY field for attributes to return
			PASSWORD: VECTOR[CH$ALLOCATION(41)];

		N[ACCFUNC]=GET_BYTE;	!OPEN/CREATE/ERASE/RENAME...

		IF ((.N[ACCFUNC] NEQ ACC$ERASE) AND (NOT .N[GOT_ATT]))
		 OR .N[MASTER]  THEN
			SEND_STATUS(MAC$SYNC,DAP_ACC);
			!Must have ATTRIBUTES before ACCESS unless DELETE
			!also, passive task must not send ACCESS message

		GETEX(N[ACCOPT],5);	!Access options
		TOPS10< IF .N[ACCOPT] NEQ 0 THEN
			SEND_STATUS(MAC$UNSUPPORT,MIC$ACC+MIC$F21);
			!Unsupported: non-fatal I/O, status return
		>
		GETVAR(FILESPEC,200,CH$SIZE()); !Store remote filespec in temp
		IF (FPARSE(FB,%REF(CH$PTR(FILESPEC)))) NEQ WIN THEN
			BEGIN
			SEND_STATUS(MAC$OPEN,ER$FNM);
			END;
		IF (.N[ACCFUNC] EQL ACC$RENAME)
		THEN
		    BEGIN
		    IF V5
		    THEN WAIT_FOR_NAME=1 !Remember to wait for NAME message
		    ELSE
			BEGIN	!This is for DAP 4.1
			EXTERNAL ROUTINE ZERO;
			LOCAL F2: REF FILE_BLOCK;
			IF (F2=.N[RENAME_FB]) EQL 0
			THEN	N[RENAME_FB]=(F2=ALLOC(FB_LEN)); !Allocate another fb
!			ZERO(.F2,.F2+FB_LEN-1);	!Clear it out first
!			COPY(FB[FILE$COUNT],F2[FILE$COUNT],.FB[FILE$COUNT]);
			 !Copy lookup block into it
			COPY(FB[FILE$START],F2[FILE$START],FB_LEN);
			!Copy the whole file block
			FBINIS(F2[FILE$START]);	!Set up, but don't clobber defaults
			FB[FILE$RENAME]=F2[FILE$COUNT];
			!Fill in rename pointer
			GETVAR(FILESPEC,128,CH$SIZE()); !copy into temp
			IF (FPARSE(.F2,%REF(CH$PTR(FILESPEC)))) NEQ WIN THEN
				BEGIN
				SEND_STATUS(MAC$OPEN,ER$FNM);
				END;
			END;
		    END;

		IF .N[MLENGTH] GTR 0
		THEN GETEX(N[FAC],3);	!File access options

		IF .N[MLENGTH] GTR 0
		THEN GETEX(N[SHR],3);	!Shared operations

		IF .N[MLENGTH] GTR 0
		THEN GETEX(DISPLAY,4);	!What attributes should we return?

		IF .N[MLENGTH] GTR 0
		THEN GETVAR(PASSWORD,40);	!Password for file access

		!If this is a (new style) RENAME, then get a NAME message
		!Otherwise, try to do the access
		IF .WAIT_FOR_NAME EQL 0
		THEN ACCESS(.NB);		!Try to do it

		IF .N[ACCFUNC] EQL ACC$OPEN THEN
			BEGIN	!Return attributes of our file
			SNDATT(.NB);	!Build attributes & send
			XOUTPUT(.NB);	!Force it out
			END;
		ACKNOWLEDGE;	!Otherwise just ACK
			!The documentation is ambiguous here
			!as to what response should occur for RENAME or DELETE
		N[GOT_ACC]=1;		!Remember we got it
		IF .WAIT_FOR_NAME EQL 0
		THEN RETURN DAP_ACC;
		END; !DAP_ACC

	[DAP_STS]:			!Some sort of error from other end
		RETURN DOSTS(NB[FILE$START]);
	[DAP_ACK]:
		IF .N[MASTER] THEN RETURN DAP_ACK
		ELSE	BEGIN
			SEND_STATUS(MAC$SYNC,DAP_ACK);
			END;
	[OTHERWISE]:
		BEGIN
		SEND_STATUS(MAC$SYNC,.MTYPE)
		END;
	TES;
	END;	!WHILE
END;			!End of DOAA (process ATTRIBUTES & ACCESS)

GLOBAL ROUTINE DOCTL(NB)=
!Routine to get a Control message and acknowledge it
!Arg:
!	NB: 	a node data block (see TBL.REQ)
BEGIN
MAP NB: REF NDB;
BIND FB=.N[FB]: FILE_BLOCK;	!File block for local side of transfer
WHILE 1 DO
	BEGIN			!Control message
	LOCAL MTYPE;		!Message type

	GET_HDR;
	SELECTONE .MTYPE OF SET

	[DAP_CTL]:
		BEGIN
		LOCAL
			CTLFUNC,	!Type of CONTROL message
			CTLMENU: EX[4],	!Menu for following fields
			RAC,		!Record access mode
			KEY: BYTE8VECTOR[256],	!Record #,Key,RFA,VBN,ckpt
			KRF,		!Key of reference (byte)
			ROP: EX[6],	!Record access options
			HSH: BYTE8VECTOR[6], !Hash code (currently reserved)
			DISPLAY: EX[4]; !Attributes messages to return

		!Eat the rest of the message
		CTLFUNC=GET_BYTE;	!Function field
		IF .NB[NDB$MLENGTH] GTR 0
		THEN GETEX(CTLMENU,4);	!Menu field if present

		!Now pick fields off the menu
		IF .CTLMENU[CTL_RAC]
		THEN RAC=GET_BYTE;	!Get RAC field
		IF .CTLMENU[CTL_KEY]
		THEN GETVC(KEY,255);	!KEY field
		IF .CTLMENU[CTL_KRF]
		THEN KRF=GET_BYTE;	!KRF
		IF .CTLMENU[CTL_ROP]
		THEN GETEX(ROP,6);	!ROP
		IF .CTLMENU[CTL_HSH]
		THEN GETVAR(HSH,5,8);	!HSH
		IF .CTLMENU[CTL_DPY]
		THEN GETEX(DISPLAY,4);	!DISPLAY


		IF .CTLFUNC NEQ C$CONNECT THEN
			BEGIN
			N[CTLFUNC]=.CTLFUNC;	!Save control message type
			!Say it's starting if anyone wants to know
			TELLJOB(.NB);
			END;

		SELECT .CTLFUNC OF SET
		[C$CONNECT]:
			BEGIN
			N[GOT_STREAM]=1;
			ACKNOWLEDGE;
			END;
%(	!Don't quite know what to do if no stream set up,
	!let it go for now
		[ALWAYS]:
			IF .N[GOT_STREAM] EQL 0 THEN
				BEGIN
				SEND_STATUS(MAC$UNSUPPORT,MIC$CTL+MIC$F20)
				END;
)%
		[C$GET]:
			IF (.EX[N[FAC],FB$GET] OR (.N[FAC] EQL 0)) THEN
				BEGIN
				XMIT(.NB);		!Send out the file
				END
			ELSE BEGIN
				SEND_STATUS(MAC$TRANS,ER$FAC)
				END;
		[C$PUT]:
			IF .EX[N[FAC],FB$PUT] THEN BEGIN
				RECV(.NB);		!Store the file
				END
			ELSE BEGIN
				SEND_STATUS(MAC$TRANS,ER$FAC)
				END;

		[OTHERWISE]:
			BEGIN
			SEND_STATUS(MAC$UNSUPPORT,MIC$CTL+MIC$F20);
			END;
		TES;
		END;
	[DAP_ACM]:	!Access Complete (close up)
		RETURN DOACM(NB[FILE$START]);
	[DAP_STS]:	!They sent us a STATUS message instead
		DOSTS(NB[FILE$START]);
	[OTHERWISE]:
		BEGIN
		SEND_STATUS(MAC$SYNC,.MTYPE)
		END;
	TES;
	END;	!While 1 do...
END;	!DOCTL

GLOBAL ROUTINE SNDATT(NB)=
!Routine to build attributes message from associated file block & send it.
BEGIN
LOCAL
	MFLAGS: EX[1],		!Message flags
	MLENGTH,		!Length of this message (data portion)
	ATTMENU: EX[6],		!Attributes menu field
	DATATYPE: EX[2],		!Data representation
	ORG,			!File organization
	RFM,			!Record format
	RAT: EX[3],		!Record attributes
	BLS,			!Block size
	MRS,			!Record size
	ALQ: BYTE8VECTOR[6],	!File size
	BKS,			!Bucket size
	FSZ,			!Fixed portion size
	MRN: BYTE8VECTOR[6],	!Max record number
	RUNSYS: BYTE8VECTOR[41],!Runtime system
	DEQ,			!Default extension quantity
	BSZ,			!Byte size
	DEV: EX[6],		!Device characteristics
	SDC: EX[6],		!Spooling device characteristics
	NOK,
	NOA,
	NOR,
	CDT: BYTE8VECTOR[18],	!Create date
	RDT: BYTE8VECTOR[18],	!Update date
	EDT: BYTE8VECTOR[18],	!Scratch date
	OWNER: BYTE8VECTOR[40],
	PROTSYS: EX[3],
	PROTOWN: EX[3],
	PROTGRP: EX[3],
	PROTWLD: EX[3],
	FOP: EX[6];
MAP NB: REF NDB;
BIND FB=.N[FB]: FILE_BLOCK;

CLEARV(MFLAGS,ATTMENU,DATATYPE,ORG,RFM,RAT,BLS,MRS,ALQ,BKS,FSZ,
	MRN,RUNSYS,DEQ,BSZ,DEV,SDC,NOK,NOA,NOR,CDT,RDT,EDT,OWNER,
	PROTSYS,PROTOWN,PROTGRP,PROTWLD,FOP);
	!Make all of these zero to start

MFLAGS[MFLAGS_LENGTH]=1;		!We will give a length field
DAT_SD(.NB,DATATYPE);		!Get datatype of file (sys dependant)
IF .N[MASTER] THEN N[DATATYPE]=.DATATYPE;	!Set in node block
ORG=0;				!Sequential files only
RAT=0;				!Set record attributes to 0 for now
IF .DATATYPE[DAT$ASC] 	!AND (.N[RFM] EQL FB$STM) !Ascii is always stream
	THEN	BEGIN
		RFM=FB$STM;
		RAT[4]=1;			!Imbedded format control
		BLS=(128*5);	!Blocksize is 128 words * 5 bytes per word
TOPS10	<	BSZ=7;>		!Byte size is 7
		END
	ELSE	BEGIN
		RFM=FB$UDF;	!Must be either Ascii stream or undefined
NORMS<
TOPS10	<	BLS=128;	!Blocksize is 128 words (or 36 bit bytes)
		BSZ=36;>>		!Byte size is 36
		END;

NORMS<
(EXTERNAL ROUTINE PRO_QD;
BIND EQ=.N[EQ]: QSR_EQ;		!Queue entry that started this
%IF %DECLARED(FILE$PROTSYS)
	%THEN PROTSYS=PRO_QD(.EQ[QSR$EQ_RPROT_SY])
	%ELSE PROTSYS=0 %FI;	!If not defined assume sys can do anything
PROTOWN=PRO_QD(.EQ[QSR$EQ_RPROT_OW]);
PROTGRP=PRO_QD(.EQ[QSR$EQ_RPROT_GR]);
PROTWLD=PRO_QD(.EQ[QSR$EQ_RPROT_WO]);
)>;
RMS<Fix the Protection stuff in SNDATT>;

DEV[FB$MDI]=DEV[FB$FOD]=DEV[FB$SHR]=DEV[FB$MNT]=DEV[FB$IDV]=DEV[FB$ODV]=1;
DEV[FB$AVL]=DEV[FB$ELG]=DEV[FB$RAD]=1;
CLEARV(ATTMENU);

MLENGTH=0;

DTM_SD(CDT,(.FB[FILE$CDATE] TOPS10<+(.FB[FILE$CDATE75]^12)>),.FB[FILE$CTIME]);
	!Set up creation date & time
DTM_SD(RDT,.FB[FILE$ADATE],%IF %DECLARED(FILE$ATIME)
		%THEN .FB[FILE$ATIME] %ELSE 0 %FI);
	!And access date (& time if we can get it (not on TOPS-10))
NUM_BV(ALQ,.FB[FILE$ALLOC]);	!Get # of blocks in file

	!Turn on extension bits where needed & count # of bytes
	BEGIN
	LOCAL T;
	T=SET_EX_BITS(DATATYPE);
	IF (.DATATYPE[DAT$ASC] OR .DATATYPE[DAT$EBC] OR .DATATYPE[DAT$CPR]
	 OR .DATATYPE[DAT$EXE] OR .DATATYPE[DAT$PRV] OR .DATATYPE[DAT$MAT])
	 NEQ 0 THEN BEGIN
		ATTMENU[ATT_DAT]=1;	!Remember to send it
		MLENGTH=.MLENGTH+.T;	!Add approprioate # of bytes
		END;
	IF .ORG NEQ FB$SEQ THEN BEGIN
		ATTMENU[ATT_ORG]=1;
		MLENGTH=.MLENGTH+1;
		END;
	IF .RFM NEQ FB$FIX THEN BEGIN
		ATTMENU[ATT_RFM]=1;
		MLENGTH=.MLENGTH+1;
		END;
	T=SET_EX_BITS(RAT);
	IF ANYSET(RAT) THEN BEGIN
		ATTMENU[ATT_RAT]=1;
		MLENGTH=.MLENGTH+.T;
		END;
	IF .BLS NEQ 512 THEN BEGIN
		ATTMENU[ATT_BLS]=1;
		MLENGTH=.MLENGTH+2;
		END;
	IF .MRS NEQ 0 THEN BEGIN
		ATTMENU[ATT_MRS]=1;
		MLENGTH=.MLENGTH+2;
		END;
	IF (T=.ALQ[0]) NEQ 0 THEN BEGIN
		ATTMENU[ATT_ALQ]=1;
		MLENGTH=.MLENGTH+.T+1
		END;
	IF .BKS NEQ 0 THEN BEGIN
		ATTMENU[ATT_BKS]=1;
		MLENGTH=.MLENGTH+1;
		END;
	IF .FSZ NEQ 0 THEN BEGIN
		ATTMENU[ATT_FSZ]=1;
		MLENGTH=.MLENGTH+1;
		END;
	IF (T=.MRN[0]) NEQ 0 THEN BEGIN
		ATTMENU[ATT_MRN]=1;
		MLENGTH=.MLENGTH+.T;
		END;
	IF (T=.RUNSYS[0]) NEQ 0 THEN BEGIN
		ATTMENU[ATT_RUN]=1;
		MLENGTH=.MLENGTH+.T;
		END;
	IF .DEQ NEQ 0 THEN BEGIN
		ATTMENU[ATT_DEQ]=1;
		MLENGTH=.MLENGTH+2;
		END;
	COPY(N[FOP],FOP,%ALLOCATION(FOP));	!Copy from NDB
	FOP=.N[FOP];	!Set from NDB
	T=SET_EX_BITS(FOP);
	IF ANYSET(FOP) THEN BEGIN
		ATTMENU[ATT_FOP]=1;
		MLENGTH=.MLENGTH+.T;
		END;
	IF .BSZ NEQ 8 THEN BEGIN
		ATTMENU[ATT_BSZ]=1;
		MLENGTH=.MLENGTH+1;
		END;
	T=SET_EX_BITS(DEV);
	IF ANYSET(DEV) THEN BEGIN
		ATTMENU[ATT_DEV]=1;
		MLENGTH=.MLENGTH+.T;
		END;
	T=SET_EX_BITS(SDC);
	IF ANYSET(SDC) NEQ 0 THEN BEGIN
		ATTMENU[ATT_SDC]=1;
		MLENGTH=.MLENGTH+.T;
		END;
%(	!This field isn't in the spec
	IF (.NOK OR .NOA OR .NOR) NEQ 0 THEN BEGIN
		ATTMENU[ATT_SAF]=1;
		MLENGTH=.MLENGTH+3;
		END;
)%
%(		!This is not the way they decided to do it!!
	IF (.CDT OR .RDT OR .EDT) NEQ 0 THEN BEGIN
		ATTMENU[ATT_DATE]=1;
		MLENGTH=.MLENGTH+54;
		END;
	IF (T=.OWNER[0]) NEQ 0 THEN BEGIN
		ATTMENU[ATT_OWN]=1;
		MLENGTH=.MLENGTH+.T;
		END;
	T=0+SET_EX_BITS(PROTSYS,PROTOWN,PROTGRP,PROTWLD);
	IF 0 OR ANYSET(PROTSYS,PROTOWN,PROTGRP,PROTWLD) THEN BEGIN
		ATTMENU[ATT_OWN]=1;
		MLENGTH=.MLENGTH+.T;
		END;
)%

	END;

MLENGTH=.MLENGTH+SET_EX_BITS(ATTMENU);


PUT_BYTE(DAP_ATT);		!Operation field
PUTEX(MFLAGS);			!Send message flags
PUT_BYTE(.MLENGTH);		!Length field
PUTEX(ATTMENU);			!Menu field
IF .ATTMENU[ATT_DAT] THEN PUTEX(DATATYPE);
IF .ATTMENU[ATT_ORG] THEN PUT_BYTE(.ORG);
IF .ATTMENU[ATT_RFM] THEN PUT_BYTE(.RFM);
IF .ATTMENU[ATT_RAT] THEN PUTEX(RAT);
IF .ATTMENU[ATT_BLS] THEN PUT_2BYTE(.BLS);
IF .ATTMENU[ATT_MRS] THEN PUT_2BYTE(.MRS);
IF .ATTMENU[ATT_ALQ] THEN PUTVAR(ALQ);
IF .ATTMENU[ATT_BKS] THEN PUT_BYTE(.BKS);
IF .ATTMENU[ATT_FSZ] THEN PUT_BYTE(.FSZ);
IF .ATTMENU[ATT_MRN] THEN PUTVAR(MRN);
IF .ATTMENU[ATT_RUN] THEN PUTVAR(RUNSYS,CH$SIZE());
IF .ATTMENU[ATT_DEQ] THEN PUT_2BYTE(.DEQ);
IF .ATTMENU[ATT_FOP] THEN PUTEX(FOP);
IF .ATTMENU[ATT_BSZ] THEN PUT_BYTE(.BSZ);
IF .ATTMENU[ATT_DEV] THEN PUTEX(DEV);
IF .ATTMENU[ATT_SDC] THEN PUTEX(SDC);
%(
IF .ATTMENU[ATT_SAF] THEN BEGIN
	PUT_BYTE(.NOK);
	PUT_BYTE(.NOA);
	PUT_BYTE(.NOR);
	END;
IF .ATTMENU[ATT_DATE] THEN BEGIN
	PUT_18BYTE(CDT);
	PUT_18BYTE(RDT);
	PUT_18BYTE(EDT);
	END;
IF .ATTMENU[ATT_OWN] THEN BEGIN
	PUTVAR(OWNER,CH$SIZE());
	PUTEX(PROTSYS);
	PUTEX(PROTOWN);
	PUTEX(PROTGRP);
	PUTEX(PROTWLD);
	END;
)%

!Now send the DATE & TIME message if needed

IF .EX[NB[NDB$SYSCAP],SYS_DTM]
AND ((.CDT NEQ 0) OR (.RDT NEQ 0) OR (.EDT NEQ 0))
 THEN	BEGIN
	LOCAL MFLAGS: EX[1];
	LOCAL MLENGTH;
	LOCAL DTMMENU: EX[1];	!Menu for this message
	CLEARV(DTMMENU,MFLAGS);	!initially 0

	MLENGTH=1;		!The menu field is always sent
	IF .CDT NEQ 0 THEN (DTMMENU[DTM_CDT]=1; MLENGTH=19);
	IF .RDT NEQ 0 THEN (DTMMENU[DTM_RDT]=1; MLENGTH=.MLENGTH+18);
	IF .EDT NEQ 0 THEN (DTMMENU[DTM_EDT]=1; MLENGTH=.MLENGTH+18);

	PUT_BYTE(IFV1E(15,DAP_DTM));	!Message type
	MFLAGS[MFLAGS_LENGTH]=1;!Length field present
	PUTEX(MFLAGS);		!FLAGS field

	PUT_BYTE(.MLENGTH);
	PUTEX(DTMMENU);	!Send the menu

				!It always consists of 3 18-character dates
	IF .DTMMENU[DTM_CDT] THEN PUT_18BYTE(CDT);	!Creation date
	IF .DTMMENU[DTM_RDT] THEN PUT_18BYTE(RDT);	!Access date
	IF .DTMMENU[DTM_EDT] THEN PUT_18BYTE(EDT);	!Scratch date
	END;	!of code to send DATE & TIME message

!
! Send PROTECTION message if needed
!
	BEGIN			!Send PROTECTION message if needed
	LOCAL	MFLAGS: EX[1],
		MLENGTH,
		PROMENU: EX[1];

	CLEARV	(PROMENU);
	MLENGTH=(1		!The menu is 1 byte long
		 ![17] Fix this so it sets the extension bits first
		 !For each non-null field: set menu bit & add in length
		 +(IF (.OWNER[0] NEQ 0)
		   THEN	(PROMENU[PRO_OWNER]=1;.OWNER[0]+1)
		   ELSE 0)
		 +(LOCAL BC;	!Byte count for field
		   BC=SET_EX_BITS(PROTSYS);
		   IF ANYSET(PROTSYS)
		   THEN (PROMENU[PRO_PROTSYS]=1;.BC)
		   ELSE 0)
		 +(LOCAL BC;	!Byte count for field
		   BC=SET_EX_BITS(PROTOWN);
		   IF ANYSET(PROTOWN)
		   THEN (PROMENU[PRO_PROTOWN]=1;.BC)
		   ELSE 0)
		 +(LOCAL BC;	!Byte count for field
		   BC=SET_EX_BITS(PROTGRP);
		   IF ANYSET(PROTGRP)
		   THEN (PROMENU[PRO_PROTGRP]=1;.BC)
		   ELSE 0)
		 +(LOCAL BC;	!Byte count for field
		   BC=SET_EX_BITS(PROTWLD);
		   IF ANYSET(PROTWLD)
		   THEN (PROMENU[PRO_PROTWLD]=1;.BC)
		   ELSE 0));
	IF (.MLENGTH GTR 1) AND .EX[NB[NDB$SYSCAP],SYS_PRO]
	 THEN	BEGIN	!We need to send it
		PUT_BYTE(IFV1E(16,DAP_PRO));		!Message type
		CLEARV(MFLAGS);			!Set up MFLAGS
		MFLAGS[MFLAGS_LENGTH]=1;	!Length field present
		PUTEX(MFLAGS);			!Send it
		PUT_BYTE(.MLENGTH);		!Length field
		PUTEX(PROMENU);			!Menu
		IF .PROMENU[PRO_OWNER] THEN PUTVAR(OWNER);	!OWNER field
		IF .PROMENU[PRO_PROTSYS] THEN PUTEX(PROTSYS);	!SYSTEM
		IF .PROMENU[PRO_PROTOWN] THEN PUTEX(PROTOWN);	!OWNER
		IF .PROMENU[PRO_PROTGRP] THEN PUTEX(PROTGRP);	!GROUP
		IF .PROMENU[PRO_PROTWLD] THEN PUTEX(PROTWLD);	!WORLD
		END;
	END;	!of code to send PROTECTION message
END;	!SNDATT

GLOBAL ROUTINE SNDACC(NB)=
!Routine to build ACCESS message & put in output buffer
!Arguments:
!NB:	NDB
BEGIN
MAP NB: REF NDB;
LOCAL MFLAGS: EX[1];
LOCAL MLENGTH;		!Length of message
LOCAL REMOTEFILE: VECTOR[CH$ALLOCATION(129)];
LOCAL REMRENAME: VECTOR[CH$ALLOCATION(129)];
LOCAL SEND_NEW_NAME;


!Make sure we request enough access to do what we want
CASE .N[ACCFUNC] FROM ACC$OPEN TO ACC$EXE OF SET
[ACC$OPEN]:		EX[N[FAC],FB$GET]=1;	!Ask for GET access
[ACC$CREATE,ACC$CMD]:	EX[N[FAC],FB$PUT]=1;	!Ask for PUT access
[ACC$RENAME,ACC$ERASE]: EX[N[FAC],FB$DEL]=1; !Ask for DELETE access
[INRANGE]:	;	!We are satisfied with GET access or we set it ourselves
[OUTRANGE]:	CRASH('Bad ACCFUNC in SNDACC');
TES;

SELECT .N[ACCFUNC] OF SET
[ACC$OPEN,ACC$CREATE,ACC$CMD]:
			!Set Block-mode I/O unless STREAM ASCII
			IF (.N[RMC$O_ASC] EQL 0)
			THEN	EX[N[FAC],FB$BIO]=1;
TES;

CLEARV(MFLAGS);
MFLAGS[MFLAGS_LENGTH]=1;	!Length field present

!Find out how long the message will be (and build a few fields in the process)
MLENGTH=SETEXB(N[ACCOPT],5)+1;
		!Length so far=1 (for ACCFUNC)+# of bytes of ACCOPT
MLENGTH=.MLENGTH+CHAZAC(CH$PTR(N[REMOTEFILE]),CH$PTR(REMOTEFILE))+1;
SEND_NEW_NAME=(		!RENAME and talking to version 4 or earlier
IF NOTV5 AND (.N[ACCFUNC] EQL ACC$RENAME)
THEN	BEGIN
	MLENGTH=.MLENGTH+CHAZAC(CH$PTR(N[REMRENAME]),CH$PTR(REMRENAME))+1;
	1		!Remember to send this filespec
	END
ELSE	0);
!Add length of the above VAR-128 fields (in first byte) +1 for first byte

MLENGTH=SETEXB(N[FAC],3)+.MLENGTH;	!File access options
MLENGTH=SETEXB(N[SHR],3)+.MLENGTH;	!Shared operations


!Now build the message a field at a time

PUT_BYTE(DAP_ACC);		!This is an access message

PUTEX(MFLAGS,1);		!Message flags (length field present)

PUT_BYTE(.MLENGTH);		!Length field

PUT_BYTE(.N[ACCFUNC]);		!Access function

PUTEX(N[ACCOPT],5);		!Access options

PUTVAR(REMOTEFILE,CH$SIZE());	!Remote file spec

IF .SEND_NEW_NAME
THEN PUTVAR(REMRENAME,CH$SIZE());	!Rename file spec if needed

PUTEX(N[FAC]);				!FAC

PUTEX(N[SHR]);				!SHR

!We never send a DISPLAY field

IF V5 AND (.N[ACCFUNC] EQL ACC$RENAME)	!New style RENAME
THEN SNDNAM(NB[FILE$START],NB[NDB$REMRENAME],0);

END;	!SNDACC

GLOBAL ROUTINE SNDNAM(NB,FILESPEC,NAMTYP)=
!Routine to send a NAME message
!Arguments:
!NB: addr of NDB
!FILESPEC: addr of ASCIZ filespec
!NAMTYP: NAMETYPE field for DAP
BEGIN
LOCAL	MFLAGS: EX[1],
	CFILESPEC: VECTOR[200/(%BPVAL/8)],	!Store ASCIC filespec here
	NAMETYPE: EX[3],			!Copy name type into here
	MLENGTH;

CLEARV(MFLAGS);
!Default NAMETYPE if necessary
IF (NAMETYPE=.NAMTYP) EQL 0
THEN NAMETYPE[NT$FSP]=1;

MFLAGS[MFLAGS_LENGTH]=1;	!LENGTH field present
MLENGTH=SET_EX_BITS(NAMETYPE)
 +CHAZAC(CH$PTR(.FILESPEC),CH$PTR(CFILESPEC,0,8))+1;
 !Convert filespec to ASCIC, & compute length of message
 ! add 1 for count byte

PUT_BYTE(DAP_NAM);		!Operator field
PUTEX(MFLAGS);			!MFLAGS field
PUT_BYTE(.MLENGTH);		!LENGTH field
PUTEX(NAMETYPE);		!NAMETYPE field
PUTVAR(CFILESPEC);		!FILESPEC field

END;

GLOBAL ROUTINE SNDCTL(NB,CFUN)=
!Build CONTROL message & put in output buffer
!Arguments:
!NB: NDB
!CFUN:	Control message function code
BEGIN
MAP NB: REF NDB;
LOCAL	MFLAGS: EX[1],
	CTLMENU: EX[1],
	RAC,
	KEY: BYTE8VECTOR[4];	!May need to grow if we support anything fancy

CLEARV(MFLAGS,CTLMENU,KEY);

IF .CFUN EQL 0 THEN CFUN=.N[CTLFUNC];	!Use code from NDB if none given
MFLAGS[MFLAGS_LENGTH]=1;
PUT_BYTE(DAP_CTL);		!This is a CONTROL message
PUTEX(MFLAGS);			!Message flags (length field present)

CTLMENU[CTL_RAC]=1;	!Always have to send a RAC
IF .N[RMC$O_ASC] EQL 0	!Anything that isn't ASCII stream is block mode
THEN	BEGIN		!Block mode file transfer
	CTLMENU[CTL_KEY]=1;
	KEY[0]=KEY[1]=1;	!Start at block 1
	RAC=RAC$BFT;	!Block mode file transfer
	END
ELSE	RAC=RAC$SEQ;	!Sequential (record mode) file transfer

PUT_BYTE((IF .KEY[0] NEQ 0 THEN .KEY[0]+1 ELSE 0)+3);	!MLENGTH
PUT_BYTE(.CFUN);!CTLFUNCtion code

PUTEX(CTLMENU);	!Send the menu

IF .CTLMENU[CTL_RAC]	!RAC field
THEN	PUT_BYTE(.RAC);	!

IF .CTLMENU[CTL_KEY]	!Key field
THEN	PUTVAR(KEY);

END;	!SNDCTL

GLOBAL ROUTINE SETEXB(EXF,LEN)=
!Turn on extension bits if any trailing bits are on
!Argument:
!EXF:	Address of extensible field
!LEN:	Length of extensible field in bytes
!Returns: # of bytes needed
BEGIN
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)=
!Convert ASCIZ string to ASCIC (counted ASCII) string
!ARGUMENTS:
!AZP:	Byte pointer to ASCIZ string
!ACP:	Byte pointer to where to store ASCIC string
!RETURNS: length of string (excluding count)
BEGIN
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)=
!Convert ASCIC string to ASCIZ string
!Arguments:
!ACP:	Byte pointer to ASCIC string
!AZP:	Byte pointer to where to store ASCIZ string
!RETURNS: length of string (excluding null byte at end)
BEGIN
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)=
!Convert an unsigned binary number into a DAP format variable-length field.
!Note that binary numbers are sent to DAP least significant byte first!!
!VAR: address of variable-length field
!NUM: value to convert
BEGIN
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 WIN);
	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)=
!Convert a variable-length field into a binary number (unsigned)
!VAR: address of variable-length field
!Returns: binary value
BEGIN
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 DOSTS(NB)=
!Routine to process a STATUS message
!Note that the message header has already been eaten
!Signals error condition & returns code
!NB: Addr of NDB
BEGIN
MAP	NB:	REF NDB;
LOCAL
	MACCODE,
	MICCODE,
	RFA: BYTE8VECTOR[9],
	RECNUM: BYTE8VECTOR[9],
	STV: BYTE8VECTOR[9];

CLEARV(RFA,RECNUM,STV);
MICCODE=GET_2BYTE;	!Put both here for now
MACCODE=.MICCODE AND %O'170000';	!Pick out MACCODE
MICCODE=.MICCODE AND %O'7777';	!and MICCODE

IF .N[MLENGTH] GTR 0 THEN GETVC(RFA,8);
IF .N[MLENGTH] GTR 0 THEN GETVC(RECNUM,8);
IF .N[MLENGTH] GTR 0 THEN GETVC(STV,8);

IF .MACCODE EQL MAC$SYNC AND .MICCODE EQL DAP_STS
THEN WARNING(.RMTERRS+.MACCODE+.MICCODE,.STV,.(STV+1))
ELSE   ERROR(.RMTERRS+.MACCODE+.MICCODE,.STV,.(STV+1));
END; !DOSTS

GLOBAL ROUTINE DOACM(NB)=
!Routine to process an ACCESS COMPLETE message
!Note that the message header has already been eaten
BEGIN
MAP NB: REF NDB;
BIND	FOP=NB[NDB$FOP]: EX,
	FB=.NB[NDB$FB]: FILE_BLOCK;
LOCAL CMPFUNC;
CMPFUNC=GET_BYTE;	!Save ACCOMP function
IF .NB[NDB$MLENGTH] GTR 0
THEN GETEX(FOP,6);	!Get a FOP field if any
CASE .CMPFUNC FROM 1 TO 4 OF SET
[ACM_CMD]:	BEGIN
		IF (FB NEQ 0)
		THEN	BEGIN
			SELECT .NB[NDB$ACCFUNC] OF SET
			%IF FTTOPS10 %THEN !Special Image-mode fix for Tops10
			[ACC$CREATE]: !Don't extend file by 1 word
				FIXIMG(NB[FILE$START],FB[FILE$START]);
			%FI	!End of TOPS-10 only code
			[ACC$OPEN,ACC$CREATE]:	!If file was open
				CLOSE(FB);	!Close the file
			TES;
			IF .FOP[FB$DLC] THEN DELETE(FB);
			RELEASE(FB);	!Release the file block
			END;
		XMTMSG(.NB,ACCOMP_RESP,ACCOMP_RESP_LEN);
		XOUTPUT(.NB); !Force it out
		!Tell opr if he cares
		TELLJOB(.NB);
		RETURN ACM_CMD	!We won & we're done
		END;
[ACM_RSP]:	SEND_STATUS(MAC$SYNC,DAP_ACM);
		!They're not supposed to send us this!!
[ACM_PRG]:	BEGIN
		IF (FB NEQ 0) THEN RELEASE(FB);
		XMTMSG(.NB,ACCOMP_RESP,ACCOMP_RESP_LEN);
		XOUTPUT(.NB);	!Force it out
		ERROR(RMTABO); !Remote system aborted transfer
		RETURN ACM_PRG	!They gave up on us
		END;
[ACM_EOS]:	BEGIN
		SEND_STATUS(MAC$UNSUPPORT,MIC$F20);
		END;
[OUTRANGE]:	BEGIN
		SEND_STATUS(MAC$INVALID,MIC$F20);
		END;
TES;
END;	!DOACM

END ELUDOM