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

%TITLE 'F R E E   -- $FREE processor'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE free (IDENT = '2.0'
		) =
BEGIN

GLOBAL BIND
    freev = 2^24 + 0^18 + 400;			! Edit date: 22-Apr-83

!+
!
!
!    FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
!    THE $FREE MACRO IN RMS-20.
!    AUTHOR:	S. BLOUNT
!
!
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1977, 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.
!
!
!
!
!    **********	TABLE OF CONTENTS	**************
!
!
!
!
!    ROUTINE			FUNCTION
!    =======			========
!
!    $FREE			$FREE MACRO PROCESSOR
!
!
!
!
!    REVISION HISTORY:
!
!
!    PRODUCT	MODULE	 SPR
!    EDIT	 EDIT	 QAR		DESCRIPTION
!    ======	======	=====		===========
!
!
!	400	400	xxxx		Cleanup BLISS code (RL)

!    ***** END OF REVISION HISTORY *****
!
!
!
!
!
!-

REQUIRE 'RMSREQ';

%SBTTL '$FREE -- $FREE processor'

GLOBAL ROUTINE $free (rabblock, errorreturn) =
! $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>
    BEGIN

    LOCAL
	temp;

    rmsentry ($free);

    !+
    !    FETCH THE ADDRESS OF USER ARGUMENTS
    !-

    rab = .rabblock;				! GET USER RAB
    erradr = .errorreturn;			! AND USER ERROR ADDRESS
    errorblock (rab);				! PUT ERRORS IN RAB

    !+
    !    CHECK VALIDITY OF USER RAB
    !-

    rst = .rab [rabisi, 0];			! GET ISI

    IF .rst [blocktype] NEQ 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, 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
    !-

    usrret ()
    END;

%( OF $FREE )%
END

ELUDOM