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

MODULE TRUNC =


BEGIN

GLOBAL BIND	TRUNV = 1^24 + 0^18 + 7;	!EDIT DATE: 6-APR-77

%([

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

	$TRUNCATE		PROCESSOR FOR $TRUNCATE MACRO





REVISION HISTORY:

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

1	JK	5-AUG-76	NEW ASCII CHANGES.
2	JK	12-AUG-76	$CONNECT; $TRUNCATE IS ILLEGAL.
3	SB	22-DEC-76	CHANGE ER$TRU TO ER$IOP
4	SB	22-FEB-77	GIVE ER$CUR IF NO RP, DONT PMAP PAGES IF PAGE 0
5	SB	24-FEB-77	FIX EDIT 4, DONT CHECK FOR SUCCESS
6	SB	6-APR-77	CHANGE HYBYTE AND FLGTRUNC TO RST

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

****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************

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

 100	  7	Dev		Make declarations for routine names
				be EXTERNAL ROUTINE so RMS will compile 
				under BLISS V4 (RMT, 10/22/85).


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




])%


	%([ EXTERNAL DECLARATIONS ])%

EXTERNAL ROUTINE
    CRASH,
    DUMP,
    GTBYTE,
    RSETUP,
    WRITEBUFFER;

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

EXTERNAL
    MSGFAILURE;		! ROUTINE FAILURE




REQUIRE 'RMSREQ';
EXTDECLARATIONS;

! $TRUNCATE
! =========

! PROCESSOR FOR $TRUNCATE MACRO.
!
!	THE $TRUNCATE MACRO LOGICALLY REMOVES ALL RECORDS
!	IN THE FILE, BEGINNING WITH THE RECORD DESIGNATED
!	BY THE "CURRENT RECORD POINTER", AND INCLUDING ALL
!	SUBSEQUENT RECORDS UNTIL THE END-OF-FILE IS REACHED.
!	NOT ONLY ARE THE RECORDS LOGICALLY REMOVED FROM THE
!	FILE, BUT THE PAGES WHICH HELD THEM ARE ALSO PHYSICALLY
!	DESTROYED, THUS SHRINKING THE SIZE OF THE FILE.
!	THE FOLLOWING RESTRICTIONS ARE IMPOSED ON THE USE
!	OF THE $TRUNCATE MACRO:
!
!		1. VALID ONLY FOR SEQUENTIAL FILES (INCLUDING ASCII,LSA)
!
!		2. ONLY ONE RAB CAN BE ACTIVE (I.E., $CONNECTED)
!
!		3. THE FILE MUST BE OPEN FOR EXCLUSIVE ACCESS.
!
!		4. FILE MUST RESIDE ON DIRECT-ACCESS DEVICE.
!
!		5. THERE MUST BE A "CURRENT RECORD".

! THE FORMAT OF THE $TRUNCATE MACRO IS:
!
!		$TRUNCATE	<RAB-ADDR> [,ERROR-ADDRESS]
!
! RAB FIELDS WHICH ARE USED AS INPUT TO $TRUNCATE:
!
!	ISI		INTERNAL STREAM IDENTIFIER
!	
!
! RAB FIELDS RETURNED TO USER:
!
!	STS		COMPLETION STATUS CODE


! INPUT:
!	ADDRESS OF USER RECORD BLOCK
!	ADDRESS OF USER ERROR ROUTINE

! OUTPUT:
!	<STATUS FIELD>

! GLOBALS USED:
!	GTBYTE
!
! NOTES:
!
!	1.	THIS ROUTINE CURRENTLY PMAPS ALL PAGES AWAY FROM AN
!		ASCII FILE IF IT IS $TRUNCATED (ALL PAGES FROM THE CURRENT
!		PAGE TO PAGE 777). IT DOES NOT PMAP AWAY PAGES BEYOND 777
!		BECAUSE THE MONITOR WILL GIVE AN ERROR IF THERE IS NO PAGE
!		TABLE FOR THE LONG-FILE PAGES.

GLOBAL ROUTINE %NAME('$TRUNCATE') ( BLOCK, ERRORRETURN ) =
BEGIN
	ARGUMENT (BLOCK,BASEADD);
	ARGUMENT (ERRORRETURN,BASEADD);

LOCAL
    CRP,
    FILEPOINTER,
    PAGECOUNT,
    P_IN_FILE,
    TEMP,
    PTR;


MAP
    FILEPOINTER:	POINTER;

	RMSENTRY ( $TRUNCATE );

	%([ FETCH THE USER'S RAB ADDRESS AND HIS ERROR ROUTINE ADDRESS ])%

	RAB = .BLOCK;				! FETCH RAB ADDRESS
	ERRADR = .ERRORRETURN;			! AND USER ERROR ADDRESS

	%([ SET UP SYSTEM-WIDE POINTERS AND MAKE SURE THAT
	   THE USER SPECIFIED $TRUNCATE ACCESS IN HIS FAC FIELD ])%

	CALLRSETUP (PCI (AXTRN));		! SET UP THINGS

	%([ MAKE SURE THIS IS A DISK FILE ])%

	IF NOT DASD THEN USERERROR (ER$DEV);	! MUST BE A DISK

	%([ THIS MUST BE A SEQUENTIAL FILE WITH ONLY ONE CONNECTED RAB ])%

	IF FILEORG GEQ ORGREL			! STREAM OR SEQ FILE
		OR
	 ( .RST [ FLINK ] ISNT .FST )		! ONLY ONE RAB IS CONNECTED
		THEN USERERROR (ER$IOP);

	%([ FILE MUST BE OPENED FOR EXCLUSIVE ACCESS ])%
	IF SHAREACCESS ISNT AXNIL THEN USERERROR (ER$XCL);

	%([ FOR SEQUENTIAL RMS FILES, DO THE FOLLOWING... ])%

	IF SEQFILE
	THEN
		BEGIN

		%([ THERE MUST BE A VALID RECORD POINTER FOR THIS
		   $TRUNCATE TO SUCCEED. THIS IS ONLY POSSIBLE IF 
		   THE LAST OPERATION WAS A SUCCESSFUL $FIND OR $GET ])%

		IF ( .RST [ RSTLASTOPER ] ISNT C$FIND
				AND
			.RST [ RSTLASTOPER ] ISNT C$GET )
		THEN
			USERERROR ( ER$CUR );		! BAD RECORD POINTER
	
		%([ LOCATE THE CURRENT RECORD IN OUR CURRENT BUFFER ])%

		CRP = .RST [ RSTDATARFA ];
		CALLGTBYTE (	%(BYTE)%	LCI (CRP),	! LOCATE RECORD
				%(FLAG)%	PCI (FALSE));

		%([ FETCH A POINTER TO THE CURRENT RECORD ])%

		FILEPOINTER = .RST [ RSTPAGPTR ];	! GET POINTER TO BUFFER
		FILEPOINTER [ WHOLEWORD ] = ZERO;	! CLEAR 1ST WORD
	

		%([ WE HAVE NOW MAPPED THE RECORD INTO OUT BUFFER,
		   AND ZEROED THE HEADER WORD.  BUT THIS IS NOT
		   ENOUGH TO GUARENTEE A GOOD EOF MARK BECAUSE
		   THE NEXT RECORD THAT WE WRITE MAY CAUSE A
		   NON-ZERO WORD TO BE TAKEN AS THE HEADER OF A
		   NON-EXISTENT RECORD. THEREFORE, WE MUST CLEAR
		   THE ENTIRE PAGE FROM THIS WORD DOWN.  IF THE
		   HEADER IS THE LAST WORD IN THE PAGE, THEN WE
		   CAN STOP. ])%

		IF ( .FILEPOINTER AND OFSETMASK ) ISNT OFSETMASK
		THEN	%(WE ARE NOT AT THE BOTTOM OF THE PAGE)%
			MOVEWORDS (	%(FROM)%	.FILEPOINTER,
					%(TO)%		.FILEPOINTER + 1,
					%(SIZE)%	( .FILEPOINTER OR OFSETMASK ) - .FILEPOINTER );
	
		P_IN_FILE = $CALL (SIZEFILE, .FST [FSTJFN]);	!GET WORD CNT
		RST [ RSTNRP ] = .CRP;				! RESET NRP TO OLD CRP
		SIZEOFFILE = .CRP;				!CROCK
	
	END %( OF TRUNCATION TO SEQUENTIAL FILES )%

	ELSE	BEGIN %( TO TRUNCATE A STREAM/LSA FILE )%

		%([ DO WE HAVE A CURRENT RECORD? ])%

		IF ENDOFFILE OR .RST [ RSTLASTOPER ] IS C$CONNECT
		THEN USERERROR ( ER$CUR );		! ** NOT POSITIONED **

		%([ SET 'CRP' TO THE BEGINNING  OF THE CURRENT, PHYSICAL REC ])%

		CRP = .RST [ RSTDATARFA ] - .RST [ RSTRHSIZE ];	!CRP IN CHARS
		SETFLAG ( RST [ RSTFLAGS ], FLGEOF );	! SET EOF
		$CALL (POSASCFIL, .FST [FSTJFN], .CRP);	!REPOS FILE
		P_IN_FILE = $CALL (SIZEFILE, .FST [FSTJFN]);	!GET CHAR CNT
		P_IN_FILE = (.P_IN_FILE+4) MOD 5;	!WORD CNT
	END; %( OF TRUNCATION FOR ASCII/LSA FILES )%


	%([ DESTROY ALL FILE PAGES FROM THIS PAGE FORWARD.
	   THIS WILL GUARANTEE THAT ANY EXISTING DATA IN THE FILE
	   WILL GO AWAY AND WILL NOT BE CONFUSED LATER FOR AN EOF MARK ])%

	%([ BUT, DON'T DO IT IF THERE IS NO CURRENT PAGE YET
	   (I.E., THE CURRENT FILE PAGE IS -1) ])%

	IF ( TEMP = (.CURRENTFILEPAGE + 1 ) ) ISNT ZERO
	THEN BEGIN
		P_IN_FILE = (.P_IN_FILE+511) MOD 512;	!WORDS TO PAGES
		$CALL (TRUNCFILE,
				%( JFN )%		.FST [ FSTJFN],
				%( NEXT PAGE)%		.TEMP,
				%( NUMBER OF PAGES )%	 .P_IN_FILE - .CURRENTFILEPAGE - 1  );
	END;

	SETFLAG ( RST [ RSTFLAGS ] , FLGTRUNC );	! REMEMBER THIS $TRUNCATE

	RST [ RSTDATARFA ] = ZERO;			! CLEAR OUT RECORD POINTER
	RAB [ RABRFA ] = ZERO;				! UNDEFINED CRP
	RST [ RSTHYBYTE ] = .CRP;			! RESET HIGHEST WRITTEN BYTE
	USEREXIT					! RETURN TO USER

END;	%( OF $TRUNCATE )%

END
ELUDOM