Google
 

Trailing-Edge - PDP-10 Archives - 704rmsf2 - 10,7/rms10/rmssrc/rmscnc.b36
There are 6 other files named rmscnc.b36 in the archive. Click here to see a list.

MODULE CONECT =

BEGIN

GLOBAL BIND	CNCTV = 1^24 + 0^18 + 19;	!EDIT DATE: 12-OCT-77

%([

FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
		THE $CONNECT AND $DISCONNECT MACROS IN RMS-20.
AUTHOR:	S. BLOUNT

THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1977, 1979 BY DIGITAL EQUIPMENT CORPORATION



**********	TABLE OF CONTENTS	**************




	ROUTINE			FUNCTION
	=======			========

	$CONNECT		PROCESSOR FOR $CONNECT MACRO

	$DISCONNECT		PROCESSOR FOR $DISCONNECT MACRO

	DCNTRAB			DISCONNECT A SINGLE RAB STREAM




REVISION HISTORY:

PRODUCT	LOCAL
EDIT	EDIT		DATE		PURPOSE
====	====		====		========

-	1		7-19		/SB ADD DISCONNECT FOR IDX FILES
-	2		7-19		/SB RESET FILE PTR FOR ASCII FILES ON CONNECT
-	3		7-21		/SB CHECK FOR ONLY 1 CONNECT RAB ON ASCII FILE
-					AND CLEAR NEWFILE BIT ON DISCONNECT
-	4		7-26		/SB TAKE OUT LAST EDIT
-	5		8-6		/JK APPENDOPTION IS ILLEGAL FOR REL. AND IDX. FILES
-	6		8-12		/JK 'SETSUCCESS' FOR '$CONNECT'.
-	7		8-27		/JK GIVE 'ER$PEF' FOR ATTEMPT TO APPEND TO REL/IDX FILE
-	
-	8		16-SEP-76	/SB ADD IDX HEADER
-	9		8-OCT-76	/SB SET THE RBF FIELD ON CONNECT
-	10		11-NOV-76	/SB USE ERROR CODE RETURNED BY SETRST
-	11		16-NOV-76	/SB TAKE OUT LOCATE MODE CHECK
-	12		20-DEC-76	/SB ADD CHECK FOR BID, BLN FIELDS
-	13		22-DEC-76	/SB CHANGE ERRSA TO ERCCR
-	14		25-FEB-77	/SB RELEASE BUFFERS AS CONTIGUOUS
-	15		30-MAR-77	/SB REMOVE CALLDELINK
-	16		7-APR-77	/SB DO EOF UPDATE IN DISCONNECT
1	17		4-OCT-77	/SB SET UP CBD IN DCNCTRAB BEFORE
					ANY BUFFER OPERATIONS ARE DONE
2	18		12-OCT-77	/SB USE RST, NOT VALUD OF RABISI TO UNLOCK

*************************************************
*						*
*		NEW REVISION HISTORY		*
*						*
*************************************************

****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************

PRODUCT	MODULE	 SPR
 EDIT	 EDIT	 QAR		DESCRIPTION
======	======	=====		===========

 100	  19	Dev		Make declaration for PUTBKT be EXTERNAL 
				ROUTINE so RMS will compile under 
				BLISS V4 (RMT, 10/22/86).


	***** END OF REVISION HISTORY *****




])%



	%([ EXTERNAL DECLARATIONS ])%


EXTERNAL ROUTINE
    CRASH,
    DUMP,
    GMEM,
    LOCKIT,
    PMEM,
    PPAGE,
    RSETUP,
    SETRST,
    WRITEBUFFER;

%([ ERROR MESSAGES REFERENCED WITHIN THIS MODULE ])%

EXTERNAL
    MSGNLW;		! NULL FILE WINDOW FOUND


FORWARD ROUTINE	DCNTRAB;		! FORWARD DECLARATIONS



REQUIRE 'RMSREQ';
EXTDECLARATIONS;



! $CONNECT
! ====

! THIS ROUTINE PROCESSES THE $CONNECT MACRO
!
! FORMAT OF THE $CONNECT MACRO:
!
!		$CONNECT	<RAB-ADDRESS> [,<ERROR-ADDRESS>]
!

! RAB FIELDS WHICH ARE USED AS INPUT TO $CONNECT:
!
!	FAB		ADDRESS OF ASSOCIATED FAB
!	KRF		KEY OF REFERENCE (INDEXED)
!	MBF		MULTI-BUFFER COUNT
!	RAC		RECORD ACCESS
!	ROP		RECORD OPTIONS
!		RB$EOF		$CONNECT TO END-OF-FILE

! RAB FIELDS RETURNED BY $CONNECT:
!
!	STS		STATUS CODE
!	ISI		INTERNAL STREAM IDENTIFIER

! INPUT:
!	ADDRESS OF RAB
!	ADDRESS OF ERROR-ROUTINE

! OUTPUT:
!	<NONE>

! GLOBALS USED:
!	GMEM
!	PMEM
!	SETRST


	%([ **** FLOW OF $CONNECT ROUTINE **** 

	1. GET FAB ADDRESS FROM RAB AND CHECK IT
	2. CHECK FOR ERRORS
	3. SET UP RST
	4. RETURN STREAM-ID TO USER

] )%

GLOBAL ROUTINE %NAME('$CONNECT') ( BLOCK, ERRORRETURN ) =
BEGIN
	ARGUMENT	(BLOCK,BASEADD);
	ARGUMENT	(ERRORRETURN,BASEADD);

LOCAL
    FILEID;

	RMSENTRY ( $CONNECT );

	%([ FETCH THE ADDRESS OF THE USER'S RAB AND ERROR ADDRESS ])%

	RAB = .BLOCK;						! GET ADDRESS OF RAB
	ERRADR = .ERRORRETURN;		! AND USER ERROR ADDRESS
	ERRORBLOCK ( RAB );					! ERRORS GO TO RAB

	%([ CHECK FOR VALID RAB CODE AND SIZE ])%

	IF .RAB [ BLOCKTYPE ] ISNT RABCODE THEN USERERROR ( ER$RAB );
	IF .RAB [ BLOCKLENGTH ] ISNT V1RABSIZE THEN USERERROR ( ER$BLN );

	%( [ FETCH FILE-ID FROM RAB ])%

	FAB = .RAB [ RABFAB ];					! GET FAB ADDRESS
	FST = .FAB [ FABIFI ];					! CONVERT IFI TO FST ADDRESS

	IF .FAB EQL 0 OR .FST EQL 0				!FILE OPEN?
	THEN USERERROR (ER$IFI);				!NO

	IF	( .FST [ BLOCKTYPE ] ISNT FSTCODE )		! OR IF IT ISNT VALID ( DOESNT POINT TO FST )
	THEN USERERROR ( ER$IFI );

	%([ CHECK NOW TO BE SURE THAT THE RB$EOF OPTION BIT
	   IS BEING USED CORRECTLY. THIS OPTION IS VALID ONLY
	   FOR SEQUENTIAL FILES (INCLUDING ASCII/LSA) ])%

	IF ( APPENDOPTION ISON ) 
	THEN IF ( FILEORG GTR ORGSEQ )
		THEN	%(THERE IS AN ERROR)%
		USERERROR ( ER$PEF );

	%([ NOTE THAT THERE IS NO CHECK HERE FOR A ZERO ISI FIELD
	   IN THE USER'S RAB.  ALTHOUGH THIS MAY SEEM LIKE A LOGICAL
	   THING TO CHECK FOR, IT WOULD MEAN THAT RMS-20 WOULD HAVE
	   TO CLEAR THE ISI FIELD WHENEVER THE RAB WAS DISCONNECTED.
	   THIS IS FINE FOR A DISCONNECT MACRO, BUT IT COULDN'T BE
	   DONE ON A CLOSE. THEREFORE, THE ISI FIELD IS OVERWRITTEN
	   IF NON-ZERO ON A CONNECT ])%


	%([ IF WE ARE CONNECTING MULTIPLE STREAMS, THEN WE
	   MUST INSURE THAT WRITE ACCESS IS NOT BEING USED IF
	   THE FILE IS ONLY FOR EXCLUSIVE ACCESS. THIS IS BECAUSE
	   MULTIPLE STREAMS MUST BE INTERLOCKED FROM EACH OTHER
	   JUST AS DIFFERENT PROCESSES ARE ALSO INTERLOCKED. THUS,
	   IF WE ARE NOT LOCKING (I.E., FAC=SHR=FB$GET OR SHR=FB$NIL),
	   THEN WE MUST CHECK THAT WE ARE ONLY READING THE FILE. ])%

	IF .FST [ FLINK ] ISNT .FST		! IF STREAM ALREADY ACTIVE
	THEN
		BEGIN
		IF ( ( NOT LOCKING ) AND IOMODE )
			OR
		   ( ASCIIFILE )
			OR
		   ( MTA )
		THEN	%(ONLY ONE STREAM IS ALLOWED)%
			USERERROR ( ER$CCR )
		END;	%(OF IF STREAM ALREADY ACTIVE)%


	%([ SET UP A RECORD STATUS TABLE ])%

	$CALL (SETRST);

	%([ PLACE THE ADDRESS OF THE USER'S BUFFER INTO
	   THE "RECORD-BUFFER ADDRESS" FIELD SO THAT THE
	   FIRST RECORD INSERTION WILL OPERATE CORRECTLY. ])%

	RAB [ RABRBF ] = .RAB [ RABUBF ];

	RAB [ RABISI ] = .RST;					! RETURN STREAM-ID
	SETSUCCESS;						! WE WERE SUCCESSFUL
	USEREXIT						! RETURN TO USER

END;	%( OF $CONNECT )%



! $DISCONNECT
! ===========

! THIS ROUTINE PROCESSES THE $DISCONNECT MACRO

! FORMAT OF $DISCONNECT MACRO:
!
!		$DISCONNECT	<RAB-ADDRESS> [,<ERROR-ADDRESS>]
!
! RAB FIELDS USED AS INPUT TO $DISCONNECT:
!
!	ISI		INTERNAL STREAM IDENTIFIER
!
!
! RAB FIELDS RETURNED BY $DISCONNECT:
!
!	STS		STATUS CODE

! INPUT:
!	ADDRESS OF RAB
!	ADDRESS OF ERROR-ROUTINE

! OUTPUT:
!	<STATUS CODE>

! GLOBALS USED:
!	DELINK
!	PMEM
!	PPAGE

GLOBAL ROUTINE %NAME('$DISCONNECT') ( BLOCK, ERRORRETURN ) =
BEGIN
	ARGUMENT	(BLOCK,BASEADD);
	ARGUMENT	(ERRORRETURN,BASEADD);


	RMSENTRY ( $DISCONNECT );
	RAB = .BLOCK;					! FETCH RAB ADDRESS
	ERRADR = .ERRORRETURN;				! AND USER ERROR ADDRESS
	ERRORBLOCK ( RAB );				! STATUS GOES TO RAB

	%([ PERFORM NORMAL SET-UP OPERATIONS JUST LIKE ANY
	   OTHER RECORD OPERATION. HOWEVER, PASS RSETUP A
	   VALUE OF "TRUE" SO THAT THE "FAC" ACCESS CHECK
	   WILL ALWAYS SUCCEED. ])%

	CALLRSETUP ( PCI ( TRUE ) );			! SET UP RST,FST, ETC.

	%([ DISCONNECT A SINGLE RECORD STREAM ])%

	CALLDCNTRAB;					! PROCESS THE RAB

	USEREXIT					! RETURN TO USER

END;	%( OF $DISCONNECT PROCESSOR )%



! DCNCTRAB
! ========

! ROUTINE TO "$DISCONNECT" A SINGLE RAB FROM A
!	FILE. THIS ROUTINE IS CALLED ONCE BY THE
!	$DISCONNECT PROCESSOR AND POSSIBLY SEVERAL
!	TIMES BY THE "$CLOSE" PROCESSOR, ONCE FOR
!	EACH DEFINED RECORD STREAM.

! INPUT:
!	<NONE>

! OUTPUT:
!	<NONE>

! GLOBALS USED:
!	PMEM
!	PPAGE
!	PUTBKT

GLOBAL ROUTINE DCNTRAB  =
BEGIN
%IF INDX %THEN
 EXTERNAL ROUTINE
	PUTBKT;
%FI
EXTERNAL ROUTINE
    ADJEOF;

LOCAL
    TEMP,
    OUREOFBYTE,		! THE EOF AS WE KNOW IT 
    BFDPTR:	POINTER,
    BUFFERPAGE,		! FIRST PAGE OF CONTIGUUS BUFFERS
    BUFFERSIZE,		! SIZE (IN PAGES) OF EACH RECORD BUFFER
    KEYBUFFSIZE,		! SIZE OF KEY BUFFER
    KEYBUFFADR;		! ADDRESS OF KEY BUFFER ( INDEXED ONLY )

	TRACE ( 'DCNCTRAB' );

	%([ WE NOW MUST INSURE THAT ALL LOCKED RECORDS FOR
	   THE STREAM HAVE BEEN UNLOCKED. THERE IS A VERY
	   EASY WAY OF DOING THIS...ISSUE A "DEQ" JSYS TO
	   UNLOCK ALL RECORDS FOR THE STREAM. HOWEVER, IF
	   THERE ARE NO LOCKED RECORDS, THIS IS AN UNNECESSARY
	   OVERHEAD. THEREFORE, FOR SEQUENTIAL/RELATIVE FILES,
	   WE WILL CHECK THE "DLOCKED" BIT IN THE RST; FOR INDEXED
	   FILES, WE WILL CHECK TO SEE IF THERE IS A CURRENT BUCKET.
	   IN EITHER CASE, ALL LOCKED RECORDS WILL BE UNLOCKED. ])%

	%([ UNLOCK ANY LOCKED RECORD ])%

	IF DATALOCKED
	THEN	%(WE MUST UNLOCK ALL LOCKED RECORDS/BUCKETS IN THE FILE)%
		$CALLOS ( ER$EDQ, ($CALL ( LOFFALL, .RST )));	! UNLOCK EVERYTHING

	%([ SET UP THE CURRENT BUFFER DESCRIPTOR POINTER ])%

	CBD = .RST + RSTCBDOFFSET;				!**[1]** GET PTR TO CURR. BKT.

	%([ FOR INDEXED FILES, FLUSH THE CURRENT BUCKET AND THE KEY BUFFER ])%

	%IF INDX %THEN
	IF IDXFILE
	THEN %(WE MUST FLUSH THE KEY BUFFER)%
		BEGIN
		RELEASCURENTBKT;
		KEYBUFFSIZE = .FST [ FSTKBFSIZE ];		! GET SIZE OF BUFFER
		KEYBUFFADR = .RST [ RSTKEYBUFF ];		! AND ITS ADDRESS
		IF .KEYBUFFSIZE ISNT ZERO
		THEN
			CALLPMEM ( LCI ( KEYBUFFSIZE ), RLCI ( KEYBUFFADR ) )
		END; %(OF IF IDXFILE)%
	%FI

	$CALL	(FLUBUF);				!PUT OUT ALL UPD BUFFERS

	%([ RELEASE ALL BUFFERS USED BY RECORD STREAM ])%

	BUFFERSIZE = .FST [ FSTBUFSIZ ] * .RST [ RSTBFDCOUNT ];	! GET SIZE OF EACH BUFFER
	BFDPTR = BFDOFFSET;			! GET PTR TO FIRST BUFFER
	BUFFERPAGE = .BFDPTR [ BFDBPAGE ];	! AND PAGE NUMBER OF FIRST ONE
	CALLPPAGE (	%( PAGE NO. )%	        LCI ( BUFFERPAGE ),
			%( PAGE COUNT )%		LCI ( BUFFERSIZE ),
			%( DESTROY )%     	PCI ( TRUE ));


	%([ FETCH OUR EOF BYTE NUMBER AND START TO COMPARE IT ])%
	%([ NOTE: FOR LSA FILES,  HYBYTE AND EOFBYTE ARE IN WORDS, NOT CHARS. ])%

	OUREOFBYTE = .RST [ RSTHYBYTE ];
	IF SEQUENCED THEN OUREOFBYTE = ( .OUREOFBYTE + 4 ) / 5;
	TEMP = ( .RST [ RSTFLAGS ] AND FLGTRUNC );	! TRUNCATE FLAG FOR ADJEOF



	IF  ( RMSFILE )				! RMS FILE (ONLY PMAPS DONE)
		AND
	( .OUREOFBYTE ISNT ZERO )		! BEEN UPDATED?
		OR
	( .TEMP ISNT ZERO  ) 			! OR ...WE DID A $TRUNCATE
	THEN	%(WE MAY HAVE TO UPDATE THE EOF POINTER)%
		$CALL 	( ADJEOF, GCI ( FST [ FSTJFN ] ),
			   LCI ( OUREOFBYTE ), LCI ( TEMP ) );



	%( [ REMOVE RST FROM FST CHAIN ] )%

	DELINK ( %(THIS RST)% RST );

	%( [ RELEASE CORE USED BY RST ] )%

	TEMP = .RST [ BLOCKLENGTH ];
	CALLPMEM (	%( BLOCK SIZE )%	LCI ( TEMP ),
			%( BLOCK PTR )%	 RGCI ( RST ));

	GOODRETURN

END;	%( OF DCNTRAB )%

END
ELUDOM