Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-sources/rmsfre.b36
There are 6 other files named rmsfre.b36 in the archive. Click here to see a list.
%TITLE 'F R E E -- $FREE processor'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE free (IDENT = '3.0 18-Nov-86'
) =
BEGIN
GLOBAL BIND
freev = 3^24 + 0^18 + 660; ! Edit date: 18-Nov-86
!+
!
!
! 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)
! 660 660 Network $FREE
! ***** END OF REVISION HISTORY *****
!
!
!
!
!
!-
REQUIRE 'RMSREQ';
EXTERNAL ROUTINE
Dap$Free_Flush; ! 660
%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
IF .Fst[Fst$v_Remote] ! 660
THEN
BEGIN
Dap$Free_Flush (.Rab, .erradr, Dap$k_Free);
UsrRet();
END;
!+
! 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