Trailing-Edge
-
PDP-10 Archives
-
BB-AE97C-BM
-
sources/dir20.b36
There are 15 other files named dir20.b36 in the archive. Click here to see a list.
MODULE DIR20(
IDENT='12',
ENTRY(
RL$PARSE, ! Parse a local filespec
RL$MERGE, ! Merge local filespecs
RL$DIRECTORY, ! Initiate directory search local
RL$SEARCH, ! Search (wildcard) local
RL$RENAME, ! Rename local file(s)
RL$ERASE ! Delete local file(s)
)
)=
BEGIN
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985.
! 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.
!++
! FACILITY: DAP
!
! ABSTRACT: Routines to transfer records or blocks of file data.
!
!
! ENVIRONMENT: RMS-20, BLISSNET-20, XPORT-20, Non-Transportable code.
!
! AUTHOR: Andrew Nourse, CREATION DATE: 14-Sep-82
!
! 12 - Don't trash JFN when no nam block is being merged in really
! 11 - Check RLF bit, not presence of an RLF, in RL$MERGE
! 10 - Make wildcard $RENAME work
! 07 - Set NAM$V_FNB_WILDCARD if any wildcard bit set in RL$MERGE
! 06 - First file on next filespec was not being processed correctly
! 05 - Use RMS BSZ instead of FDB BSZ if it is an RMS file
! 04 - Fix wildcard delete and rename
! 03 - Put in ENTRY points
! 02 - Supress device we get from JFN always if remote file
! 01 - Separate system-dependant functions of DIRECT into this module
!--
!
! INCLUDE FILES:
!
!LIBRARY 'BLI:XPORT';
LIBRARY 'RMS';
LIBRARY 'BLISSNET';
LIBRARY 'CONDIT';
LIBRARY 'DAP';
%BLISS36(
LIBRARY 'TWENTY';
! LIBRARY 'BLI:TENDEF';
! LIBRARY 'BLI:MONSYM';
)
!
! Table of Contents
!
FORWARD ROUTINE
RL$PARSE, ! Parse a local filespec
RL$MERGE, ! Merge local filespecs
RL$DIRECTORY, ! Initiate directory search local
RL$SEARCH, ! Search (wildcard) local
RL$RENAME, ! Rename local file(s)
RL$ERASE; ! Delete local file(s)
!
! Feature Tests
!
COMPILETIME MULTIPLE_FILESPECS=1;
!
! Externals
!
EXTERNAL ROUTINE
S$JFN_STR,
MOVEAZ,
DAP$MERGE,
DAP$HANDLE,
R$NULL,
R$$MERGE;
%IF MULTIPLE_FILESPECS
%THEN EXTERNAL ROUTINE RL$NEXTFILESPEC %FI;
!
! System Services
!
LINKAGE JSYS1S=JSYS(REGISTER=1;REGISTER=1): SKIP(1);
LINKAGE JSYS2S=JSYS(REGISTER=1,REGISTER=2;REGISTER=1,REGISTER=2): SKIP(1);
LINKAGE JSYS3E=JSYS(REGISTER=1,REGISTER=2,REGISTER=3): SKIP(-1);
BIND ROUTINE GTFDB__=GTFDB_: JSYS3E;
BIND ROUTINE GNJFN__=GNJFN_: JSYS1S;
BIND ROUTINE GTJFN__=GTJFN_: JSYS2S;
BIND ROUTINE RLJFN__=RLJFN_: JSYS1S;
BIND ROUTINE RNAMF__=RNAMF_: JSYS2S;
BUILTIN SCANN;
!
! MACROS:
!
MACRO CRLF=%CHAR(13,10) %;
MACRO LH=18,18 %;
MACRO RH= 0,18 %;
!
! EQUATED SYMBOLS:
!
LITERAL
FILE_NAME_LENGTH=40;
LITERAL
FILESPEC_FIELD_SIZE=40; ! Length of filespec field in directory list
!
! OWN STORAGE:
!
GLOBAL ROUTINE RL$PARSE(FAB: REF $FAB_DECL, ERR)=
!++
! FUNCTIONAL DESCRIPTION:
!
! Decompose a local filespec & merge in related filespec
!
! FORMAL PARAMETERS:
!
! FAB: A FAB as defined by RMS
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! Standard RMS completion codes
!
!--
BEGIN
RL$MERGE(FAB[$],
MERGE$M_EXPANDED+MERGE$M_RLF+MERGE$M_POINT,
.ERR)
END; ! RL$PARSE
GLOBAL ROUTINE RL$MERGE (FAB: REF $FAB_DECL, FLAGS: BITVECTOR, ERR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Merge the related file spec with the filespec
! to get the resultant file spec
!
! FORMAL PARAMETERS:
!
! FAB: Address of FAB, which may have NAM block attached
! FLAGS: Merge bits, defined in RMSUSR
!
! COMPLETION CODES:
!
! RMS codes
!
! SIDE EFFECTS:
!
! GTJFN will have been done on the filespec
! The JFN will be in FAB[FAB$H_JFN]
!
!--
BEGIN
MAP FAB: REF $FAB_DECL;
BIND NAM=.FAB[FAB$A_NAM]: $NAM_DECL;
BIND ROUTINE $$ERRRTN=.ERR: RMS_ERCAL;
LOCAL DESC: $STR_DESCRIPTOR(CLASS=BOUNDED);
LOCAL RESULT;
LOCAL GJBLK: VECTOR[$GJATR-1]; ! GTJFN block
LOCAL NEXT; ! Offset to next filespec
LOCAL WILDJFN; ! Build indexable file handle here
IF .FAB[FAB$V_FOP_OFP]
THEN NEXT=0 ! No multiple output filespecs
ELSE NEXT=.NAM[NAM$H_WCC_NEXT]; ! Input multpile filespecs OK
IF .FAB[FAB$V_FOP_CIF] THEN FLAGS[MERGE$V_CIF]=1; ! Set Create-if if in FAB
IF .FAB[FAB$V_FOP_OFP] THEN FLAGS[MERGE$V_CREATE]=1; ! Set create if in FAB
![11] Do not automatically use related filespec if resultant
CLEARV(GJBLK);
GJBLK[$GJSRC]=$NULIO+($NULIO^18);
IF .FLAGS[MERGE$V_CREATE]
THEN GJBLK[$GJGEN]=GJ_OFG+GJ_IFG+GJ_FOU+GJ_XTN
ELSE GJBLK[$GJGEN]=GJ_IFG+GJ_XTN;
IF (.FAB[FAB$H_JFN] EQL 0)
OR .FLAGS[MERGE$V_POINT]
THEN
BEGIN ! Get a JFN if we need one
LOCAL BEGPTR;
LOCAL ENDPTR;
IF .FAB[FAB$V_REMOTE] THEN RETURN 0; ! Never do this for remote file
! Point to next filespec
BEGPTR=CH$PLUS(.FAB[FAB$A_FNA],.NEXT);
IF GTJFN__(GJBLK,.BEGPTR; RESULT,ENDPTR)
THEN
BEGIN
IF .FAB[FAB$H_JFN] EQL 0 ! If we need this JFN
THEN
BEGIN
LOCAL MULTIPLE;
MULTIPLE=.NAM[NAM$V_FNB_MULTIPLE]; ! Save this bit
FAB[FAB$H_JFN]=.RESULT; ! Save the JFN
NAM[NAM$G_FNB]=.RESULT^-18; ! Save the flags
NAM[NAM$V_FNB_MULTIPLE]=.MULTIPLE; ! Keep set if it was before
END
ELSE RLJFN__(.RESULT<0,18>); ! Don't need this JFN
IF .FLAGS[MERGE$V_POINT] ! Incr offset to next if requested
THEN NAM[NAM$H_WCC_NEXT]=
.NAM[NAM$H_WCC_NEXT]+CH$DIFF(.ENDPTR,.BEGPTR)-1;
SELECT SCANN(ENDPTR) OF ! Check for multi-filespec delimiters
SET
[%C',', %C'+']: NAM[NAM$V_FNB_MULTIPLE]=1; ! Multiple filespecs
TES;
END
ELSE
BEGIN
IF .FAB[FAB$H_JFN] EQL 0 ! If we need the JFN
THEN ! Do not complain if
BEGIN ! just sizing filespec
FAB[FAB$H_STS]=(SELECT .RESULT OF
SET
[GJFX24]: RMS$_FNF;
[GJFX35]: RMS$_PRV;
[OTHERWISE]: RMS$_CGJ;
TES);
SIGNAL(.FAB[FAB$H_STS], FAB[FAB$H_STV]=.RESULT, FAB[$]);
RETURN .FAB[FAB$H_STS]
END;
END;
END;
NAM[NAM$V_FNB_WILDCARD]= ![7] If any wildcard, set this
(.NAM[NAM$G_FNB] AND NAM$M_FNB_WILDCARD_BITS) NEQ 0;
WILDJFN=.FAB[FAB$H_JFN];
IF .FLAGS[MERGE$V_EXPANDED] ! For expanded filespec
OR .FLAGS[MERGE$V_DEFAULTS] ! or default setting
THEN WILDJFN=.WILDJFN+(.NAM[NAM$G_FNB]^18); ! Make Indexable file handle
! Set up expanded string
$STR_DESC_INIT(DESC=DESC, CLASS=BOUNDED,
STRING=(.NAM[NAM$H_ESS],.NAM[NAM$A_ESA]));
NAM[NAM$H_ESL]=S$JFN_STR(.WILDJFN,DESC,0);
! Fill in the blocks
$STR_DESC_INIT(DESC=DESC, CLASS=BOUNDED, ! Device
STRING=(FILE_NAME_LENGTH,CH$PTR(NAM[NAM$T_DEV])));
S$JFN_STR(.WILDJFN,DESC,FLD($JSAOF,JS_DEV)+JS_PAF);
$STR_DESC_INIT(DESC=DESC, CLASS=BOUNDED, ! Directory
STRING=(FILE_NAME_LENGTH,CH$PTR(NAM[NAM$T_DIR])));
S$JFN_STR(.WILDJFN,DESC,FLD($JSAOF,JS_DIR)+JS_PAF);
$STR_DESC_INIT(DESC=DESC, CLASS=BOUNDED, ! Name
STRING=(FILE_NAME_LENGTH,CH$PTR(NAM[NAM$T_NAM])));
S$JFN_STR(.WILDJFN,DESC,FLD($JSAOF,JS_NAM)+JS_PAF);
$STR_DESC_INIT(DESC=DESC, CLASS=BOUNDED, ! Extension
STRING=(FILE_NAME_LENGTH,CH$PTR(NAM[NAM$T_EXT])));
S$JFN_STR(.WILDJFN,DESC,FLD($JSAOF,JS_TYP)+JS_PAF);
$STR_DESC_INIT(DESC=DESC, CLASS=BOUNDED, ! Generation
STRING=(7,CH$PTR(NAM[NAM$T_VER])));
S$JFN_STR(.WILDJFN,DESC,FLD($JSAOF,JS_GEN)+JS_PAF);
IF .FLAGS[MERGE$V_DEFAULTS] ! Getting defaults from JFN
AND .FAB[FAB$V_REMOTE] ! but the file is remote
THEN
BEGIN
CH$WCHAR(0,CH$PTR(NAM[NAM$T_DVI])); ! [2] do not believe device
CH$WCHAR(0,CH$PTR(NAM[NAM$T_VER])); ! Supress generation number
RETURN FAB[FAB$H_STS]=RMS$_SUC ! Get out
END;
R$$MERGE(NAM[$],.FLAGS); ! Merge in related filespec
IF .FLAGS[MERGE$V_RLF] ![11] If we merged something
AND (NAM NEQ .NAM[NAM$A_RLF]) ![12] different
AND (.NAM[NAM$A_RLF] NEQ 0) ![12]
THEN ! Then we need to get a new
BEGIN ! JFN
LOCAL WINFLAG;
RLJFN__(.FAB[FAB$H_JFN]);
GJBLK[$GJJFN]=.FAB[FAB$H_JFN]; ! Get this JFN back
GJBLK[$GJGEN]=.GJBLK[$GJGEN] OR FLD($GJERR,GJ_JFN);
IF (WINFLAG=GTJFN__(GJBLK,.NAM[NAM$A_RSA];RESULT)) EQL 0
THEN
BEGIN
IF .FLAGS[MERGE$V_CIF] ! Try new file if CIF
THEN
BEGIN
GJBLK[$GJGEN]=GJ_NEW+GJ_OFG+GJ_IFG+GJ_XTN+FLD($GJERR,GJ_JFN);
WINFLAG=GTJFN__(GJBLK,.NAM[NAM$A_RSA];RESULT);
END;
IF .WINFLAG EQL 0 ! Still failed?
THEN
BEGIN
FAB[FAB$H_JFN]=0; ! Blew this JFN away
FAB[FAB$H_STS]=(SELECT .RESULT OF
SET
[GJFX24]: RMS$_FNF;
[GJFX35]: RMS$_PRV;
[OTHERWISE]: RMS$_CGJ;
TES);
SIGNAL(.FAB[FAB$H_STS],
FAB[FAB$H_STV]=.RESULT,
FAB[$]);
RETURN .FAB[FAB$H_STS]
END;
END;
END;
FAB[FAB$H_STS]=RMS$_SUC ! Win
END; ! RL$MERGE
GLOBAL ROUTINE RL$DIRECTORY (FAB,ERR) = ! Get next file
!++
! FUNCTIONAL DESCRIPTION:
!
! 'Open' a local directory for listing
!
! FORMAL PARAMETERS:
!
! FAB: A FAB as defined by RMS -- FNA contains wildcard spec
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! Standard RMS codes
!--
BEGIN
MAP FAB: REF $FAB_DECL;
BIND ROUTINE $$ERRRTN=.ERR: RMS_ERCAL;
BIND NAM=.FAB[FAB$A_NAM]: $NAM_DECL; ! Name block
LOCAL FABSAV: VOLATILE;
LOCAL ERRSAV: VOLATILE;
ENABLE DAP$HANDLE(FABSAV,ERRSAV); ! Setup Condition handler
ERRSAV=.ERR;
FABSAV=.FAB; ! Handler will need this
RL$MERGE(FAB[$],MERGE$M_EXPANDED+MERGE$M_RLF+MERGE$M_POINT,.ERR)
END; !End of RL$DIRECTORY
GLOBAL ROUTINE RL$SEARCH (FAB,ERR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Get directory info for a local file
!
! FORMAL PARAMETERS:
!
! FAB: A FAB as defined by RMS -- FNA contains wildcard spec
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! Standard RMS status codes
!--
BEGIN
MAP FAB: REF $FAB_DECL;
LOCAL DESC: $STR_DESCRIPTOR();
BIND NAM=.FAB[FAB$A_NAM]: $NAM_DECL;
BIND ROUTINE $$ERRRTN=.ERR: RMS_ERCAL;
BIND TYP=.FAB[FAB$A_TYP]: $TYP_DECL;
LOCAL CLASS;
IF TYP NEQ 0 ! If we have a datatype block,
THEN CLASS=.TYP[TYP$H_CLASS] ! get the datatype class from it
ELSE CLASS=0;
IF NAM EQL 0 THEN (FAB[FAB$H_STS]=RMS$_NAM; ! Must have a NAM block
$$ERROR(GET,FAB[$])); ! or can't do this
! Set up descriptor for expanded string
$STR_DESC_INIT(DESC=DESC,STRING=(.NAM[NAM$H_RSS],.NAM[NAM$A_RSA]));
IF (.NAM[NAM$H_WCC_COUNT] NEQ 0) ! No GNJFN first time through
THEN
BEGIN !
IF GNJFN__((.NAM[NAM$G_FNB]^18)+.FAB[FAB$H_JFN];NAM[NAM$Z_CHA]) EQL 0
THEN
BEGIN
FAB[FAB$H_STS]=RMS$_NMF; ! No more files
%IF MULTIPLE_FILESPECS ! Scan another filespec:
%THEN ! User can supply
IF RL$NEXTFILESPEC(FAB[$],.ERR) EQL 0 ! multiple filespecs,
THEN RETURN .FAB[FAB$H_STS] !
%FI !
END; ! File1,file2,file3
END;
!
! Now get the information for the file
!
BEGIN
LOCAL FAC,
FNA,
JFN,
RFM,
MRS,
FOP;
FAC=.FAB[FAB$H_FAC]; ! Save FAC
FOP=.FAB[FAB$H_FOP]; ! and FOP
JFN=.FAB[FAB$H_JFN]; ! And JFN
FNA=.FAB[FAB$A_FNA]; ! And file name pointer
RFM=.FAB[FAB$Z_RFM]; ! And Record Format
MRS=.FAB[FAB$H_MRS]; ! And max record size
NAM[NAM$H_RSL]=S$JFN_STR(.FAB[FAB$H_JFN],DESC,0); ! Get name
IF .FAB[FAB$V_FAC_BIO] EQL 0
THEN
BEGIN
FAB[FAB$H_FAC]=FAB$M_FAC_NIL; ! No access
FAB[FAB$V_FOP_DRJ]=0; ! Do not keep JFN
FAB[FAB$H_JFN]=0; ! do not use this JFN
FAB[FAB$A_FNA]=.NAM[NAM$A_RSA]; ! Use resultant name
$OPEN(FAB=FAB[$]); ! Open file to get attrs
IF .FAB[FAB$H_STS] EQL RMS$_SUC
THEN $CLOSE(FAB=FAB[$]); ! Close it again
FAB[FAB$H_FAC]=.FAC; ! Restore these to what user gave us
FAB[FAB$H_FOP]=.FOP; !
FAB[FAB$H_JFN]=.JFN; !
FAB[FAB$A_FNA]=.FNA; !
END;
! Get the length from the monitor, RMS won't do that for us
BEGIN
LOCAL FDBBUF: VECTOR[$FBLEN];
LOCAL BSZ;
GTFDB__(.FAB[FAB$H_JFN],$FBLEN^18,FDBBUF);
FAB[FAB$G_ALQ]=.FDBBUF[$FBBYV] AND FB_PGC; ! # of pages
! Get byte size
BSZ=.POINTR((FDBBUF[$FBBYV]),FB_BSZ);
IF (.BSZ NEQ 0) ! If nonzero
AND (.FAB[FAB$Z_RFM] EQL FAB$K_RFM_STM) ![5] and file is stream
OR (.FAB[FAB$Z_BSZ] EQL 0) ![5] or RMS has 0
THEN FAB[FAB$Z_BSZ]=.BSZ ! use BSZ from FDB
%IF %DECLARED(XABFHC)
%THEN
BEGIN ! File Header Characteristics
XABFHC[XAB$G_EBK]=.FDBBUF[$FBSIZ]/((%BPUNIT/.BSZ)*512);
XABFHC[XAB$H_FFB]=.FDBBUF[$FBSIZ] MOD ((%BPUNIT/.BSZ)*512);
END;
%FI;
IF (.FDBBUF[$FBCTL] AND FB_DIR) NEQ 0 ! File is a directory?
THEN FAB[FAB$Z_ORG]=FAB$K_ORG_DIRECTORY; ! Set file organization
IF .TYP[TYP$H_CLASS] EQL TYP$K_CLASS_MACY11 ! MACY11?
THEN
BEGIN
LOCAL SIZE;
SIZE=.FDBBUF[$FBSIZ]; ! Size in bytes according to FDB
IF .BSZ EQL 36 THEN SIZE=.SIZE*4; ! Really 8-bit bytes
FAB[FAB$Z_RFM]=.RFM;
FAB[FAB$H_MRS]=.MRS;
IF .RFM EQL FAB$K_RFM_FIX
THEN FAB[FAB$G_MRN]=.SIZE/.FAB[FAB$H_MRS];
END;
END;
END;
NAM[NAM$H_WCC_COUNT]=.NAM[NAM$H_WCC_COUNT]+1; ! Incr wildcard count
IF .FAB[FAB$H_STS] EQL RMS$_SUC
THEN RL$MERGE(FAB[$],MERGE$M_RLF,.ERR) ! Get resultant filespec, etc.
ELSE $$ERROR(OPEN,FAB[$]); ! Call error routine if error
.FAB[FAB$H_STS] ! Return status
END; !End of RL$SEARCH
GLOBAL ROUTINE RL$RENAME (SFAB,DFAB,ERR) = ! Rename a file or files
!++
! FUNCTIONAL DESCRIPTION:
!
! Rename a local file or files
!
! FORMAL PARAMETERS:
!
! SFAB: A FAB as defined by RMS
! DFAB: A FAB as defined by RMS
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! RMS-20 codes
!
! SIDE EFFECTS:
!
! The JFN (if any) may have changed
!--
BEGIN
MAP SFAB: REF $FAB_DECL;
MAP DFAB: REF $FAB_DECL;
BIND SNAM=.SFAB[FAB$A_NAM]: $NAM_DECL;
BIND DNAM=.DFAB[FAB$A_NAM]: $NAM_DECL;
BIND ROUTINE $$ERRRTN=.ERR: RMS_ERCAL;
!++
! Get JFN, fill in NAM block, etc.
!--
WHILE (SNAM[NAM$H_WCC_COUNT]=0;
(RL$DIRECTORY(SFAB[$],R$NULL) EQL RMS$_SUC)
AND (RL$SEARCH(SFAB[$],R$NULL) NEQ RMS$_NMF))
![10] Start over each time because rename breaks chain
DO
BEGIN
LOCAL RESULT;
LOCAL TJFN; ![4]
IF GTJFN__(GJ_SHT+GJ_IFG,.SNAM[NAM$A_RSA];TJFN) EQL 0 ![10] Wildcard
THEN ![4] GTJFN failed
BEGIN ![4]
SFAB[FAB$H_STS]=RMS$_CGJ; ![4]
SFAB[FAB$H_STV]=.TJFN; ![4]
$$ERROR(OPEN,SFAB[$]); ![4]
END ![4]
ELSE
BEGIN
IF (.SFAB[FAB$Z_ORG] NEQ FAB$K_ORG_DIRECTORY)
THEN
BEGIN
! Get resultant new name
RL$MERGE(DFAB[$],MERGE$M_RLF+MERGE$M_CREATE,.ERR);
IF RNAMF__(.TJFN<RH>,.DFAB[FAB$H_JFN];RESULT) ![10] Rename it
THEN
BEGIN
RLJFN__(.DFAB[FAB$H_JFN]); ! Release JFN for new name
DFAB[FAB$H_JFN]=0; ! Get old JFNs out of blocks
SFAB[FAB$H_STS]=DFAB[FAB$H_STS]=RMS$_SUC; ! Win
END
ELSE
BEGIN
SFAB[FAB$H_STS]=DFAB[FAB$H_STS]=RMS$_COF; ! Can't open file
SFAB[FAB$H_STV]=DFAB[FAB$H_STV]=.RESULT; ! System code
$$ERROR(OPEN,SFAB[$])
END
END;
END;
END;
IF .SFAB[FAB$H_STS] EQL RMS$_NMF ! If we did all the files
THEN SFAB[FAB$H_STS]=RMS$_SUC; ! then that's normal
IF .SFAB[FAB$V_FOP_DRJ] EQL 0 ! Get rid of jfn unless want to keep
THEN
BEGIN
RLJFN__(.SFAB[FAB$H_JFN]); ! Release JFN
SFAB[FAB$H_JFN]=0; ! and forget it
END;
.SFAB[FAB$H_STS] ! Return status
END; !End of RL$RENAME
GLOBAL ROUTINE RL$ERASE (SFAB,ERR) = ! Delete a file or files
!++
! FUNCTIONAL DESCRIPTION:
!
! Delete a local file or files
!
! FORMAL PARAMETERS:
!
! SFAB: A FAB as defined by RMS
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! RMS-20 codes
!
! SIDE EFFECTS:
!
!--
BEGIN
MAP SFAB: REF $FAB_DECL;
BIND ROUTINE $$ERRRTN=.ERR: RMS_ERCAL; ! Error routine
BIND SNAM=.SFAB[FAB$A_NAM]: $NAM_DECL;
! Caller can set this bit before the call to disable local files.
IF .SFAB[FAB$V_REMOTE] ! Must it be remote?
THEN
BEGIN
SFAB[FAB$H_STS]=RMS$_SUP;
$$ERROR(OPEN,SFAB[$]); ! Yes. complain
END;
RL$DIRECTORY(SFAB[$],.ERR); ! Get JFN, etc
WHILE (RL$SEARCH(SFAB[$],R$NULL) NEQ RMS$_NMF) ! Find next file
DO
BEGIN
LOCAL TFAB: $FAB_DECL; ![4] Make temp FAB
$FAB_INIT(FAB=TFAB, FNA=.SNAM[NAM$A_RSA]); ![4] init to resultant name
IF .SFAB[FAB$Z_ORG] NEQ FAB$K_ORG_DIRECTORY
THEN
BEGIN
$ERASE(FAB=TFAB[$]); ![4] Erase it
SFAB[FAB$H_STS]=.TFAB[FAB$H_STS]; ![4] Keep status
IF .TFAB[FAB$H_STS] NEQ RMS$_SUC
THEN
BEGIN
SFAB[FAB$H_STV]=.TFAB[FAB$H_STV]; ![4] Keep secondary status
$$ERROR(ERASE,SFAB[$]) ![4] process error
END;
END;
END;
SFAB[FAB$H_JFN]=0; ! This JFN is bye-bye.
IF .SFAB[FAB$H_STS] EQL RMS$_NMF ! If we did all the files
THEN SFAB[FAB$H_STS]=RMS$_SUC; ! then that's normal
.SFAB[FAB$H_STS] ! Return status
END; !End of RL$ERASE
GLOBAL BIND ROUTINE RMS$MERGE=RL$MERGE;
GLOBAL BIND ROUTINE RMS$DIRECTORY=RL$DIRECTORY;
GLOBAL BIND ROUTINE RMS$SEARCH=RL$SEARCH;
END
ELUDOM ! End of module