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