Google
 

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


BEGIN

GLOBAL BIND	FREEV = 1^24 + 0^18 + 1;	!EDIT DATE: MAY 1, 1976

%([

FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
		THE $FREE MACRO 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
	=======			========

	$FREE			$FREE MACRO PROCESSOR




REVISION HISTORY:

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

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

 100	  1	Dev		Make declarations for routine names
				be EXTERNAL ROUTINE so RMS will compile 
				under BLISS V4 (RMT, 10/22/85).


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




])%



	%([ FORWARD DECLARATIONS ])%


	%([ EXTERNAL DECLARATIONS ])%

	EXTERNAL ROUTINE
	    CRASH,
	    DUMP;

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





REQUIRE 'RMSREQ';
EXTDECLARATIONS;


! $FREE
! =====

! PROCESSOR FOR $FREE MACRO
!	THIS PROCESSOR UNLOCKS ALL RECORDS WHICH ARE CURRENTLY
!	LOCKED FOR A PARTICULAR RECORD STREAM. IF NO RECORDS
!	ARE LOCKED, AN "ER$RNL" ERROR CODE IS RETURNED.
!	FOR INDEXED FILES, THE CURRENT BUCKET, IF ANY, MUST BE
!	RELEASED SINCE ALL THE CODE IN $DELETE AND $UPDATE
!	ASSUMES THAT IF THERE IS A CURRENT BUCKET, IT IS CORRECTLY
!	LOCKED. FOR SEQUENTIAL/RELATIVE FILES, THE CURRENT RFA
!	MUST BE FLAGGED AS NOT BEING LOCKED.
!
! FORMAT OF $FREE MACRO:
!
!		$FREE	<RAB-ADDR> [, ERROR-ADDRESS]
!
! RAB FIELDS USED AS INPUT:
!
!	ISI 		INTERNAL STREAM IDENTIFIER
!
! RAB FIELDS RETURNED TO USER:
!
!	STS		COMPLETION STATUS CODE

! NOTES:
!
!	1.	THERE IS CURRENTLY NO CHECK TO SEE IF THERE ARE
!		ARE ANY LOCKED BUCKETS OR RECORDS FOR THE STREAM.
!		THE "CURRENT" BUCKET OR RECORD IS SIMPLY MARKED
!		AS NULL, AND ALL RESOURCES ARE DEQ'ED (MAY NOT
!		BE ANY).
!
!	2.	THERE IS CURRENTLY NO CHECK FOR ASCII/LSA FILES,
!		WHICH CAN NEVER HAVE LOCKED RECORDS. THIS CHECK
!		IS UNNECESSARY BECAUSE THE EXTRA CODE IS NOT
!		JUSTIFIED FOR THIS UNUSUAL CONDITION.


! INPUT:
!	ADDRESS OF USER RAB
!	ADDRESS OF USER ERROR RETURN

! OUTPUT:
!	<NONE>

GLOBAL ROUTINE %NAME('$FREE') ( BLOCK, ERRORRETURN ) =
BEGIN
	ARGUMENT (BLOCK,BASEADD);		! USER RAB ADDRESS
	ARGUMENT (ERRORRETURN,BASEADD);		! USER ERROR RETURN

LOCAL
	TEMP;
EXTERNAL ROUTINE
    PUTBKT;
	RMSENTRY ( $FREE );

	%([ FETCH THE ADDRESS OF USER ARGUMENTS ])%

	RAB = .BLOCK;				! GET USER RAB
	ERRADR = .ERRORRETURN;			! AND USER ERROR ADDRESS
	ERRORBLOCK ( RAB );			! PUT ERRORS IN RAB

	%([ CHECK VALIDITY OF USER RAB ])%

	RST = .RAB [ RABISI ] ;			! GET ISI
	IF .RST [ BLOCKTYPE ] ISNT RSTCODE	! IS IT OK?
	THEN USERERROR (ER$ISI);			! NO


	%([ FOR INDEXED FILES, WE MUST INDICATE THAT
	   THERE IS NO CURRENT BUCKET. FOR NON-INDEXED
	   FILES, WE MUST CLEAR THE "DATA-LOCKED" BIT. ])%

	%IF INDX %THEN
	IF IDXFILE
	THEN
		BEGIN
		CBD = .RST + RSTCBDOFFSET;	! GET PTR TO CURRENT BUCKET
		SETBKTUNLOCKED ( CBD );		! MAKE SURE IT IS UNLOCKED
		RELEASCURENTBKT		! FLUSH IT
		END	%(OF IF INDEXED FILE)%

	ELSE	%(IT'S A SEQ/REL FILE)%
	%FI

		CLRFLAG ( RST [ RSTFLAGS ], FLGDLOCK );	! CLEAR LOCKED FLAG
	%([ NOW, DEQ ALL RECORDS IN THIS STREAM ])%

	$CALLOS ( ER$RNL, ($CALL ( LOFFALL, .RST )) );	!DEQ BY REQUEST-ID WHICH IS = ADDR OF RST
 
	%([ INDICATE SUCCESS SO THE CURRENT CONTEXT (I.E., LAST
	   OPERATION WAS NOT A $FIND) IS CHANGED. ])%

	SETSUCCESS;

	%([ EXIT TO USER ])%

	USEREXIT

END;	%( OF $FREE )%
END
ELUDOM