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

MODULE ERASE =
BEGIN

GLOBAL BIND	ERASV = 1^24 + 0^18 + 1;	!EDIT DATE: 31-JAN-77

%([

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

	$ERASE			PROCESSOR FOR $ERASE MACRO




REVISION HISTORY:

EDIT		DATE		WHO			PURPOSE
====		====		===			=======

1		31-JAN-77	SB		MAP ERROR CODES

*************************************************
*						*
*		NEW REVISION HISTORY		*
*						*
*************************************************

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


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




])%



	%([ FORWARD DECLARATIONS ])%


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






REQUIRE 'RMSREQ';
REQUIRE	'RMSOSD';			!CONTAINS MONITOR DEPENDENT STUFF
EXTDECLARATIONS;

	%([ ERROR MAPPING TABLES DEFINED FOR THE $ERASE MACRO.
		ERRORMAP EXPANDS DIFFERENTLY ON THE 10 AND 20. ])%

	%IF TOPS20 %THEN
	BIND	DELERRTAB = UPLIT (
		OSERRMAP ( ER$JFN , DESX3 ),	! JFN IS NOT ASSIGNED
		OSERRMAP ( ER$PRV , DELFX1, WHELX1 ),	! DELETE ACCESS REQUIRED
		OSERRMAP ( ER$FNC , DELFX2 ),	! FILE IS NOT CLOSED
		OSERRMEND;
	%FI

! $ERASE
! ======

! PROCESSOR FOR THE $ERASE MACRO.
!
!	THIS ROUTINE PERFORMS THE FUNCTION OF FILE DELETIONS.
!	IT WILL ACCEPT EITHER A FULL NAME STRING OR A JFN AS
!	INPUT. HOWEVER, THE FILE MUST BE CLOSED BEFORE THE
!	$ERASE IS ISSUED.  THE JFN WILL ALWAYS BE RELEASED 
!	AFTER THE DELETION UNLESS THE FB$DRJ BIT IS SET IN
!	THE FOP FIELD OF THE FAB.
!
!	FORMAT OF THIS MACRO:
!
!		$ERASE 		<FAB-NAME>[,ERROR-ADDRESS]
!

! INPUT:
!	ADDRESS OF USER FILE ACCESS BLOCK (FAB)
!	ADDRESS OF USER ERROR ROUTINE

! OUTPUT:
!	<NO STATUS RETURN>

! GLOBALS USED:
!	<NONE>

GLOBAL ROUTINE %NAME('$ERASE') ( BLOCK, ERRORRETURN ):NOVALUE =
BEGIN
	ARGUMENT	(BLOCK,BASEADD);	! FILE BLOCK ADDRESS
	ARGUMENT	(ERRORRETURN,BASEADD);	! ERROR ADDRESS

REGS;

%IF TOPS10 %THEN
LOCAL
    FOPARG: VECTOR[$FOPAT],	!ALLOC FILOP ARG BLK
    FILBLK: VECTOR[$RBSIZ],	!LOOKUP BLK
    PATHBLK: VECTOR[14],	!FOR SFD'S IN FILE SPEC
    RENABLK: VECTOR[4];
%FI


	LOCAL
		JFN;				! TEMPORARY JFN

	EXTERNAL OPNERRTAB;

	RMSENTRY ('$ERASE' );
	FAB = .BLOCK;
	ERRADR = .ERRORRETURN;		! AND USER ERROR ADDRESS
	ERRORBLOCK ( FAB );

	%IF TOPS10 %THEN
	IF ( JFN = .FAB [ FABJFN ] ) IS ZERO  
	THEN
		BEGIN

		CLEAR (FILBLK[$RBCNT],$RBSIZ-$RBCNT+1);	!ZERO FILBLK
		AC2 = .FAB[FABFNA];			! GET JFN/STRING POINTER

		%([ IF THE ADDRESS OF THE FILE-NAME IS ZERO IN THE
		   LEFT HALF, MAKE IT INTO AN ASCII BYTE POINTER. ])%

		IF .AC2<LH> IS ZERO			!IF WHOLE WORD PTR
		THEN	AC2 = POINT (.AC2, 36, 7 );	! MAP TO ASCII PTR

		AC1 = $CALLM(PAR10FS, .AC2, FOPARG, FILBLK, PATHBLK);
		IF .AC1 NEQ TRUE			!PARSE FILE SPEC SUCCESSFULLY?
		THEN USERERROR(ER$FSI);

	END %( OF IF .FAB [ FABJFN ] IS ZERO )%

	ELSE	BEGIN %(HE IS GIVING US HIS OWN JFN...CHECK IT OUT)%
		ERROR (ER$JFN);			!NOT SUPPORTED ON 10
	END; %(OF ELSE...)%

	%([ TRY TO OPEN THE FILE ])%

	CLEAR (RENABLK,4);			!DELETING THE FILE
	FOPARG[$FOFNC] = FO$ASC OR $FODLT;	!SET XTEND CHAN & FUNCT
	FOPARG[$FOIOS] = $IODMP;		!OPEN STATUS
	FOPARG[$FOBRH] = 0;			!NO BUFFERS
	FOPARG[$FONBF] = 0;			!DITTO
	FOPARG[$FOLEB] = RENABLK^18 OR FILBLK;	!PTR TO FIL BLK
	FILBLK[$RBCNT] = $RBSIZ;		! ??? SIZE OF FILEBLK
	AC1 = $FOPAT^18 OR FOPARG;		!ARG BLK PTR

	IF NOT UUO ( 1, FILOP$(AC1) )		!IF FAIL, ERR CODE IN AC1
	THEN MAPSYSTEMCODE ( %(DEFAU)% ER$CEF,%(TAB)%   OPNERRTAB );

	%FI

	%IF TOPS20
	%THEN

	IF ( JFN = .FAB [ FABJFN ] ) IS ZERO	%([ DID HE GIVE US A JFN? ])%
	THEN	BEGIN			%(WE MUST GET ONE FOR HIM)%

		AC2 = .FAB [ FABFNA ];
		IF .AC2<LH> IS ZERO
		THEN
			AC2 = POINT ( .FAB [ FABFNA ], 36, 7 );	! SET ASCII POINTER
		AC1 = GJ_OLD + GJ_SHT;
		JSYS_FAIL ( GTJFN )
		THEN
			MAPSYSTEMCODE ( %(DEFAULT)% ER$CGJ, %(TABLE)% OPNERRTAB)
		ELSE JFN = .AC1;
		FAB [ FABJFN ] = .JFN		! PUT JFN IN FAB
	END; %(OF IF HE DIDN'T GIVE US A JFN)%

	%([ WE MUST NOW DETERMINE IF THE FILE IS ALREADY OPEN.
	   ALTHOUGH TOPS-20 ALLOWS AN OPEN FILE TO BE DELETED,
	   FOR COMPATIBILITY WITH RMS-11/32, WE WILL MAKE THIS
	   ILLEGAL. ])%

	AC1 = .JFN;
	AC2 = ZERO;
	DO_JSYS ( GTSTS);		! GET THE STATUS
	IF CHKFLAG ( AC2, GS_OPN ) ISON
	THEN	%(WE CANT ALLOW HIM TO ERASE THE FILE)%
		USERERROR ( ER$FNC );			! FILE NOT CLOSED

	%([ TRY TO DELETE THE FILE ])%

	AC1 = DF_NRJ + .JFN;			! FLAGS+JFN
	IF NOT JSYS ( -1, DELF )
	THEN
		MAPSYSTEMCODE ( %(DEFAULT)% ER$CEF, %(CODE TABLE)% DELERRTAB );

	%([ NOW, WE MUST CLEAR THE JFN FIELD AND RELEASE THE
	   JFN IF HE WANTED US TO DO IT ])%

	IF CHKFLAG ( FAB [ FABFOP ], FOPDRJ ) IS OFF
	THEN
	BEGIN
		AC1 = .JFN;
		DO_JSYS ( RLJFN );		! RELEASE IT
		FAB [ FABJFN ] = ZERO;		! CLEAR HIS FIELD
	END;	%(OF IF WE SHOULD RELEASE THE JFN)%
	%FI

	USEREXIT				! **EXIT TO USER


END; %(OF $ERASE)%

END ELUDOM