Trailing-Edge
-
PDP-10 Archives
-
704rmsf2
-
10,7/rms10/rmssrc/rmstrn.b36
There are 6 other files named rmstrn.b36 in the archive. Click here to see a list.
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