Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/rmstrn.b36
There are 6 other files named rmstrn.b36 in the archive. Click here to see a list.
%TITLE 'T R U N C   -- $TRUNCATE service'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE trunc =
BEGIN

GLOBAL BIND
    trunv = 3^24 + 0^18 + 622;			!EDIT DATE: 4-JUN-86

!+
!
!
!    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, 1986 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		*
!    *						*
!    *************************************************
!
!    PRODUCT	MODULE	 SPR
!    EDIT	 EDIT	 QAR		DESCRIPTION
!    ======	======	=====		===========
!    560                                Remote $Truncate
!    614            			BLK-mode $Truncate
!    622				V2 bug $Truncating large
!					seq file: bad page calculation
!
!    ***** END OF REVISION HISTORY *****
!
!
!
!
!
!-
!+
!    EXTERNAL DECLARATIONS
!-

REQUIRE 'RMSREQ';

EXTERNAL ROUTINE
    Dap$Truncate,
    Psizefile;			!614
%SBTTL '$TRUNCATE - $TRUNCATE processor'

GLOBAL ROUTINE $truncate (rabblock, errorreturn) =
! $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.
!
    BEGIN

    LOCAL
	crp,
	filepointer : REF BLOCK,
	pagecount,
	p_in_file,
	temp,
	ptr;

    rmsentry ($truncate);

    !+
    !    FETCH THE USER'S RAB ADDRESS AND HIS ERROR ROUTINE ADDRESS
    !-

    rab = .rabblock;				! 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
    !-

    rsetup (axtrn);				! SET UP THINGS

    !+
    !    REMOTE FILE TRUNCATE
    !-
    IF .Fst[Fst$v_Remote]
    THEN
        BEGIN
        Dap$Truncate( .rab, .erradr );
        UsrRet();
        END;

    !+
    !    LOCAL FILE TRUNCATE (rest of routine)
    !-

    !+
    !    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] NEQ .fst)		! ONLY ONE RAB IS CONNECTED
    THEN
	usererror (er$iop);

    !+
    !    FILE MUST BE OPENED FOR EXCLUSIVE ACCESS
    !-

    IF shareaccess NEQ 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] NEQ c$find AND 	!
	    .rst [rstlastoper] NEQ c$get)	!
	THEN
	    usererror (er$cur);			! BAD RECORD POINTER

	!+
	!    LOCATE THE CURRENT RECORD IN OUR CURRENT BUFFER
	!-

	crp = .rst [rstdatarfa];
	gtbyte (.crp, 				! Locate record
	    false);				! Flag

	!+
	!    FETCH A POINTER TO THE CURRENT RECORD
	!-

	filepointer = .rst [rstpagptr];		! GET POINTER TO BUFFER
	filepointer [wholeword] = 0;		! 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) NEQ ofsetmask
	THEN 					! Not at bottom of page
	    movewords (.filepointer, 		! From
		.filepointer + 1, 		! To
		(.filepointer OR ofsetmask) - .filepointer);	! Size

	p_in_file = sizefile (.fst [fstjfn]);	! Get word count
	rst [rstnrp] = .crp;			! Reset NRP to old CRP
	fst [fstsof] = .crp;			! Crock [why? 4-83, RL]
	END
    ELSE
	BEGIN					! Truncate a stream/LSA file

!+ 614	BLK-mode $TRUNCATE.  Kill pages from the page specified 
!	by RAB BKT to the end of file.  Set the highest byte written
!	to the last byte on the last remaining page after truncation,
!	so a close will update the bytecount.  If more flavors of
!	$TRUNCATE are needed, make the follow test a SELECT.
!-
        IF (.Rab[Rab$b_Rac] AND Rab$k_Blk) NEQ 0 !614
        THEN
        BEGIN		!BLK-mode $TRUNCATE

          LOCAL Bkt: INITIAL(.Rab[Rab$g_Bkt]),	!File page # to trunc after
                p_in_file,                     	!File page count
                bytes_per_page,			!Bytes/page
                truncflg;

          ! Special case for VBN=0, the FDB
          IF .Bkt EQL 0				!Can't truncate the FDB
          THEN usererror (er$cur);          

          ! Get file's page count
          p_in_file = psizefile (.fst[fstjfn]) ;  !Get # pages in file

          IF .Bkt GTR .p_in_file  !Can't truncate after last page
          THEN usererror (er$cur);

          ! Kill remaining pages
          Truncfile (.fst[fstjfn],
                    .Bkt,
                    .p_in_file - .Bkt + 1);

          ! Flag the $TRUNCATE
          setflag (rst[rstflags], flgtrunc);
          truncflg = (.rst[rstflags] AND flgtrunc);

          ! Set "Highest byte written" to the last byte # of the
          ! highest remaining page in the file
          bytes_per_page = (%BPVAL/.fst[fst$h_Bsz]) * pagesize;
          rst[rsthybyte] = (.Bkt-1) * .bytes_per_page;

          ! Flag EOF
          setflag (rst [rstflags], flgeof);

          ! Reset the FDB now
          Adjeof (.fst[fstjfn],.rst[rsthybyte],truncflg);

          rst[rstdatarfa] = 0;			!No crp any more
          Rab[rabrfa, 0] = 0;
          usrret ();
        END;		!BLK-mode $TRUNCATE


	!+
	!    Do we have a current record?
	!-

	IF endoffile OR 			! No truncation at EOF
	    .rst [rstlastoper] EQL c$connect	!   or if just $CONNECTed.
	THEN
	    usererror (er$cur);			! ** Not positioned **


	!+
	!    Set CRP to the beginning of the current physical record.
	!-

	crp = .rst [rstdatarfa] - .rst [rstrhsize];	! CRP in chars
	setflag (rst [rstflags], flgeof);	! Set EOF
	posascfil (.fst [fstjfn], .crp);	! Reposition file
!	p_in_file = sizefile (.fst [fstjfn]);	! Get char count   !622
!	p_in_file = (.p_in_file + 4) MOD 5;	! Word count       !622
	END;

!+
!    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)) NEQ 0
    THEN
	BEGIN
	p_in_file = psizefile (.fst [fstjfn]);  ! PAGES IN FILE 	!622
	truncfile (.fst [fstjfn], 		! JFN
	    .temp, 				! Next page
	    .p_in_file - .currentfilepage );	! Number of pages	!622
	END;

    setflag (rst [rstflags], flgtrunc);		! REMEMBER THIS $TRUNCATE
    rst [rstdatarfa] = 0;			! CLEAR OUT RECORD POINTER
    rab [rabrfa, 0] = 0;			! UNDEFINED CRP
    rst [rsthybyte] = .crp;			! RESET HIGHEST WRITTEN BYTE
    usrret ()					! RETURN TO USER
    END;					! End $TRUNCATE

END

ELUDOM