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

MODULE ERRORS =

BEGIN

GLOBAL BIND	ERROV = 1^24 + 0^18 + 17;	!EDIT DATE: 30-DEC-81

%([
FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
		USER OR SYSTEM ERRORS.

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, 1981 BY DIGITAL EQUIPMENT CORPORATION


AUTHOR:	S. BLOUNT/RL


**********	TABLE OF CONTENTS	**************




	ROUTINE			FUNCTION
	=======			========

	DOEOF			PROCESS AN EOF CONDITION

	CRASH			PROCESS AN INTERNAL RMS-20 ERROR

	PRICHK			CHKS IF MSG SHOULD BE OUTPUT

	FERROR			CHECK FOR ALL OPEN/CREATE USER ERRORS

	OABORT			ABORT THE OPEN/CREATE PROCESSING AND
				UNWIND ALL THAT HAD BEEN DONE UP TO
				THE POINT THAT THE USER ERROR WAS DETECTED

	CHECKXAB		SCAN XAB CHAIN FOR ERRORS DURING $CREATE

	CLEANUP			CLEAN-UP AFTER A $PUT FAILURE FOR INDEXED FILE

	REMOVRECORD		SIMILAR TO CLEANUP EXCEPT THE RECORD MUST
				BE DELETED FROM SOME SECONDARY INDICES

	MAPCODES		PERFORM MAPPING FROM SYSTEM TO RMS ERROR CODES






REVISION HISTORY:

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

1		7-15		UNMAP PLOGPAGE BEFORE CLOSING THE FILE
2	JK	20-JUL-76	TEXT ARG TO 'CRASH' AND 'FPROBLEM' POINTS TO
				WORD CONTAINING USER ERROR CODE FOLLOWED BY
				WORDS CONTAINING TEXT OF MESSAGE.
3	SB	7-SEP-76	ADD REMOVRECORD
4	SB	8-SEP-76	REMOVE MAX KEYPOS ERROR
5	SB	22-SEP-76	TAKE OUT CHECK FOR DUPS ON PRIMARY KEY
6	SB	22-SEP-76	TAKE OUT CHECK FOR MAXFILLPERCENT
7	SB	18-OCT-76	ADD ERNPK IN CHECKXAB

8	SB	18-OCT-76	ADD CHECK FOR BAD COD VALUE IN CHECKXAB
9	SB	18-OCT-76	ADD LOCKING IN REMOVRECORD
10	SB	1-NOV-76	DELETE FPROBLEM
11	SB	11-NOV-76	ADD CHECK FOR ZERO BKS IN CHECKXAB
12	SB	8-DEC-76	PUT CHECK FOR PRIMARY KEY CHANGE IN CHKXAB
13	SB	23-DEC-76	UNDO EDIT 11
14	SB	13-JAN-77	ADJUST CHECKXAB TO GIVE BETTER ERRORS
15	SB	31-JAN-77	CHANGE CHECKXAB SO AREA XAB'S MAY COME ANYWHERE

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

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

	***** Release of Version 1.0  *****

55	16	20-16698	Given an indexed file with two keys (key 0
                                allows duplicates, key 1 is no duplicates), if
                                a duplicate record is written to the file such
                                that a 3-way split occurs, the no-duplicate
                                second key will cause REMOVRECORD to be called
                                to back out the data record.  However,
                                REMOVRECORD searches only the current data
                                bucket for the ID of the new record, not the
                                new bucket created for that record.  When the
                                record is deleted, it is the wrong record and
                                the file begins to get corrupted.  This is
                                cured by using POSRFA instead of SDATABKT to do
                                an RFA search for the duplicate record rather
                                than an ID search of only one bucket.

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

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

 100	  17	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
    BUGCOD;		! PLACE TO STORE LAST BUG CODE

EXTERNAL ROUTINE
    DELSIDR,	! DELETE A SIDR RECORD
    FILEQ,
    MOVEKEY,	! MOVE A KEY STRING
    SDATABKT,	! SEARCH A DATA BUCKET
    PLOGPAGE,
    PUTBKT,		! RELEASE A BUCKET
    LOCKIT;

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

EXTERNAL
    MSGKDB,			! SOMETHING WRONG WITH KDB
    MSGFAILURE,		! A ROUTINE FAILED
    MSGINPUT;		! BAD INPUT ARGUMENT

FORWARD ROUTINE	CRASH: NOVALUE;



REQUIRE 'RMSREQ';
EXTDECLARATIONS;

! DOEOF
! =====

! THIS ROUTINE IS CALLED WHENEVER THE END-OF-FILE IS REACHED
!	ON A SEQUENTIAL OR A RELATIVE FILE.
!	 ITS FUNCTION IS TO UNLOCK THE CURRENT RECORD AND
!	PERFORM ANY OTHER CLEAN-UP OPERATIONS WHICH MAY BE
!	NECESSARY IN THE FUTURE

! INPUT:
!	<NONE>

! OUTPUT:
!	<NONE>

GLOBAL ROUTINE DOEOF: NOVALUE  =
BEGIN

LOCAL
    CRP;



	%([ UNLOCK THE CURRENT RECORD ])%

	CRP = .RST [ RSTDATARFA ];		! GET ITS ADDRESS
	IF DATALOCKED THEN UNLOCK ( CRP );	! UNLOCK IT, IF NECESSARY
	RAB [ RABRSZ ] = ZERO;			! TELL HIM HE HAS A NULL RECORD
	RST [ RSTDATARFA ] = ZERO;		! CLEAR OUR KNOWLEDGE

	ERROR ( ER$EOF )				! GIVE USER ERROR


END; %( OF DOEOF )%

! CRASH
! =====

! THIS ROUTINE IS CALLED WHENEVER AN INTERNAL CONSISTENCY ERROR IS
!	FOUND. ITS PURPOSE IS TO PRINT OUT A DISGNOSTIC MESSAGE
!	AND TO HALT PROCESSING. NO ATTEMPT IS MADE TO RECOVER
!	FROM THE PROBLEM .

! INPUT:
!	TXTADR = ADDRESS OF AN N+1 WORD BLOCK:
!		FIRST WORD CONTAINS ERROR CODE
!		SECOND THROUGH N+1 CONTAIN MESSAGE TEXT

! OUTPUT:
!	<NONE>

GLOBAL ROUTINE CRASH ( TXTADR ): NOVALUE =
BEGIN
LOCAL
    RETURNADR;		! CONTAINS THE RETURN PC
!NOTE: This routine displays the PC. So if more arguments are added to it
!	the value of RETURNADR must be recomputed. The existing technique does
!	not work.

	ARGUMENT (TXTADR,BASEADD);


	%([ IF WE ARE NOT PRINTING MESSAGES...DON'T DO IT ])%

	%([ CHECK TO SEE IF THE CURRENT BUG IS THE SAME AS THE LAST ONE.
	   IF SO, WE WILL JUST EXIT AND NOT DO ANY USEFUL WORK. IF NOT,
	   WE WILL PRINT OUT THE MESSAGE FOR THIS BUG AND RETURN TO THE USER ])%

	IF (.BUGCOD ISNT .TXTADR)  AND  (CHKFLAG (RMSSTS, STSNOMESSAGE) IS OFF)
	THEN	BEGIN				!INTERNAL ERROR MSG
	 	RETURNADR = .( TXTADR + 1 );
		TXTOUT(RM$IER, .ROUTINENAME, .RETURNADR<RH>-1, .TXTADR+1);
	END;					! OF IF THIS IS A NEW BUG CODE

	BUGCOD = .TXTADR;			! SAVE THIS ADDRESS
	USRSTS = ..TXTADR;			! SETUP ERROR CODE FOR USER
	USRSTV = .TXTADR + 1;			! RET PTR TO TEXT MSG
	USEXITERR				! EXIT TO USER

END; %( OF CRASH )%

! PRICHK
! =====

!  THIS ROUTINE CHECKS IF MSG SHOULD BE OUTPUT TO TERMINAL

! INPUT:
!		VALUE OF USRSTV

! OUTPUT:
!	TRUE IF MESSAGE SHOULD BE OUTPUT, FALSE OTHERWISE

GLOBAL ROUTINE PRICHK ( TXTADR ) =
BEGIN


	IF .USRSTS NEQ ER$BUG THEN BADRETURN;	![%50] MSG N/A UNLESS ER$BUG

	%([ CHECK TO SEE IF THE CURRENT BUG IS THE SAME AS THE LAST ONE.
	   IF SO, WE WILL JUST EXIT AND NOT DO ANY USEFUL WORK. IF NOT,
	   WE WILL PRINT OUT THE MESSAGE FOR THIS BUG AND RETURN TO THE USER ])%

	IF ( .BUGCOD EQL .TXTADR ) THEN BADRETURN;

	BUGCOD = .TXTADR;			! SAVE THE NEW VAL
	IF   ( CHKFLAG ( RMSSTS, STSNOMESSAGE ) IS OFF )
	THEN GOODRETURN
	ELSE BADRETURN;

END; %( OF PRICHK )%

! FERROR
! ======

! THIS ROUTINE ANALYZES THE USER'S REQUESTS TO $OPEN
!	A FILE AND CHECKS IT FOR ERRORS.
!	WHEN ENTERED, THE FAB AND FPT MUST HAVE
!	BEEN INITIALIZED. ON EXIT, THE APPROPRIATE ERROR
!	CODE WILL HAVE BEEN SET IN "USRSTS". IN GENERAL,
!	THIS ROUTINE WILL ALWAYS EXIT TO THE CALLER
!	IF AN ERROR IS DISCOVERED
!

! INPUT:
!	<NONE>

! OUTPUT:
!	TRUE:	NO ERRORS FOUND
!	FALSE:	ERROR

!
!	{ THE FOLLOWING ERRORS ARE DETECTED BY THIS ROUTINE ]
!
!	ASCII FILES:
!		1.  FB$BLK IS ILLEGAL
!		2.  UPDATE AND DELETES ARE NOT ALLOWED
!		3.  ONLY 1 WRITER OF THE FILE IS ALLOWED SIMULTANEOUSLY
!		4.  THE BYTE SIZE MUST BE 7.
!
!	RMS FILES:
!		1.  MUST BE DASD IF RELATIVE FILE
!		2.  MRS CANT BE 0 IF RELATIVE FILE
!		3.  DEVICE MUST BE  DASD ( THIS IS A TEMPORARY RESTRICTION FOR VERSION 1)
!
!	ALL FILES:
!		1.  UNUSED ATTRIBUTES MUST BE ZERO
!		2.  VARIOUS VALUES MUST BE WITHIN PROPER RANGE
!		3.  RECORD FORMAT MUST AGREE WITH THE FILE ORGANIZATION
!
!

GLOBAL ROUTINE FERROR  =
BEGIN

LOCAL
    TEMP;

	TRACE ( 'FERRORS' );

	%([ MAKE SURE THE RECORD FORMAT AGREES WITH THE ORGANIZATION ])%

	IF	( ( STREAM ) OR ( SEQUENCED ) )
			AND
		( NOT ASCIIFILE )
			THEN RETURNSTATUS ( ER$RFM );					! MUST BE SEQ FILE FOR ASCII/LSA


	%([ CHECK ASCII FILE ERRORS ])%

	IF ASCIIFILE
	THEN

		BEGIN
		IF .FAB [ FABBSZ ] ISNT ASCIIBYTESIZE THEN RETURNSTATUS ( ER$BSZ );	! CHECK BYTE SIZE
		IF BLOCKED THEN RETURNSTATUS ( ER$RAT );				! RECORDS MUST SPAN PAGES
		IF ( ( (  .FAB [ FABFAC ]  AND  .FAB [ FABSHR ]  AND AXPUT ) ISON ) AND DASD )  THEN RETURNSTATUS ( ER$FAC );

		%([ IF THIS IS A SEQUENCED FILE ON THE TTY, IT CANNOT
		   BE OPENED FOR BOTH INPUT AND OUTPUT	])%

		IF SEQUENCED AND TTY AND IOMODE THEN RETURNSTATUS ( ER$FAC )
		END;

	%([ RMS-FILE ERRORS ])%

	IF RMSFILE
	THEN
		BEGIN

		%([ CHECK THAT THE MRS FIELD IS BEING USED CORRECTLY ])%

		IF .FAB [ FABMRS ] IS ZERO
		THEN
			BEGIN
			IF RELFILE OR FIXEDLENGTH THEN RETURNSTATUS ( ER$MRS )
			END;
		IF NOT DASD THEN RETURNSTATUS ( ER$DEV );		! MUST BE A DISK FILE
		END; %( OF RMS-FILE CHECKS )%

	%([ CHECK VARIOUS PARAMETERS ])%

	IF FILEORG GTR ORGMAX THEN RETURNSTATUS ( ER$ORG );		! CHECK FILE ORGANIZATION VALUE

	IF ( .FAB [ FABBSZ ] GTR 36 ) OR ( .FAB [ FABBSZ ] IS ZERO )
	THEN
		RETURNSTATUS ( ER$BSZ );	! CHECK BYTE SIZE

	%([ FOR FUTURE COMPATIBILITY, MAKE SURE THAT THE UNSED
	   ROP BITS ARE NOT SET ])%

	IF ( .FAB [ FABRAT ] AND RATUNUSED ) ISNT ZERO
		THEN RETURNSTATUS ( ER$RAT );				! CHECK UNDEFINED RAT BITS

	IF .FAB [ FABRFM ] GTR RFMMAX THEN RETURNSTATUS ( ER$RFM );	! CHECK RECORD FORMAT

	IF FILEACCESS IS ZERO THEN RETURNSTATUS ( ER$FAC );	! DONT ALLOW A NULL FAC


	GOODRETURN


END; %( OF FERROR )%

! OABORT
! ======

! THIS ROUTINE PROCESSES THE ABORTING OF AN $OPEN OR $CREATE MACRO
!	IT IS CALLED WHENEVER AN ERROR IS FOUND IN THE
!	$OPEN PROCESSING. THIS ROUTINE PERFORMS ANY NECESSARY
!	CLEAN-UP AND EXITS DIRECTLY TO THE USER. THIS
!	TECHNIQUE IS USED TO SIMPLIFY THE FLOW OF THE
!	$OPEN PROCESSOR.

! INPUT:
!	FLAGS FOR ABORTING (IN GLOBAL OAFLAGS):
!		ABRUNLOCK - UNLOCK FILE
!		ABRCLOSE - CLOSE FILE
!		ABRFST - RELEASE FILESTATUS TABLE
!		ABRPLOGPAGE - RELEASE THE FREE PAGE USED FOR PROLOGUE
!		ABRADB - RELEASE THE AREA DESCRIPTOR BLOCK
!	VALUE TO PUT IN USRSTS OR DIRECTIVE THAT CALL WAS FROM USRRET

! OUTPUT:
!	<NONE>

GLOBAL ROUTINE OABORT ( ERRORCODE ): exitsub NOVALUE =
BEGIN
	ARGUMENT (ERRORCODE,VALUE);
LOCAL
    FLAGS,
    TEMP;
MAP
    TEMP:	POINTER;

	TRACE  ( 'OABORT' );

	FLAGS = .OAFLAGS;		!USE LOCAL SO
	OAFLAGS = ZERO;			!...AVOID POSSIB OF RECURS ERR LOOP

	%([ UNLOCK FILE RESOURCES IF LOCKED ])%

	IF ( .FLAGS AND ABRUNLOCK ) ISON
	THEN   CALLFILEQ ( PCI ( DEQCALL ) , PCI ( DEQDR ));

	%([ RELEASE CORE FOR FILE PROLOGUE TABLE ])%
	%([ *NOTE THAT THIS PAGE MUST BE UNMAPPED BEFORE THE FILE IS CLOSED* ])%

	IF ( ( .FLAGS AND ABRPLOGPAGE ) ISON )
	THEN	CALLPPAGE ( GCI ( PLOGPAGE ), PCI ( 1 ), PCI ( TRUE ) );

	%([ CLOSE FILE ])%

	IF ( .FLAGS AND ABRCLOSE ) ISON
	THEN	BEGIN
		$CALL	(ABORTFILE, .USERJFN, .FAB);	! USER JFN AND ADDRESS OF FAB
	END;



	%([ RELEASE CORE FOR FILE-STATUS TABLE ])%

	IF (  ( .FLAGS AND ABRFST ) ISON )
	THEN

		BEGIN

		%([ FIRST, WE MUST RELEASE ALL KEY DESCRIPTORS
		   FOR THIS FILE. FOR NON-INDEXED FILES, THERE
		   WONT BE ANY KEY DESCRIPTORS. AND, FOR INDEXED
		   FILES, THE ONLY SITUATION IN WHICH THERE WOULD
		   BE A KDB CHAIN THAT WE WILL HAVE TO FLUSH IS IF
		   THE USER GAVE AN XAB CHAIN ON THE $OPEN AND THERE
		   WAS AN ERROR DURING ITS PROCESSING. ])%

		%IF INDX %THEN
		CALLUNDOKDBS;				! FLUSH ALL KDBS
		%FI
		TEMP = .FST [ BLOCKLENGTH ];
		CALLPMEM ( LCI ( TEMP ), RGCI ( FST ) )
		END; %(OF IF ABRFST IS ON)%

	%([ RELEASE CORE FOR AREA DESCRIPTOR BLOCK ])%

	IF (  ( .FLAGS AND ABRADB ) ISON )
	THEN

		BEGIN
		TEMP = .ADB [ BLOCKLENGTH ];		! GET LENGTH OF FST
		CALLPMEM ( LCI ( TEMP ), RGCI ( ADB ) )	! RELEASE CORE
		END; %(OF IF ABRADB IS ON)%

	IF .ERRORCODE EQL 0 THEN RETURN;	!CALLED FROM USEREXIT

	USRSTS = .ERRORCODE;			! STORE ERROR CODE
	USEXITERR

END; %( OF OABORT ROUTINE )%

! CHECKXAB
! ========

! THIS ROUTINE SCANS THE XAB'S OF THE USER ON A $CREATE.
!	IT CHECKS THE FOLLOWING THINGS:
!		1)  BLOCK-TYPE
!		2)  XAB COD-TYPE (KEY,ALLOCATION,ETC.)
!		3)  DATA-TYPE
!		4)  FLAGS
!		5)  KEY OF REFERENCE VALUE
!		6)  KEY POSITION AND SIZE
!		7)  INDEX AND DATA FILL OFFSETS
!		8)  ORDER OF THE XAB'S

! INPUT:
!	<NONE>

! OUTPUT:
!	TRUE:	OK
!	FALSE:
!		<ERROR CODE STORED IN USRSTS>

! GLOBALS USED:
!	<NONE>

 GLOBAL ROUTINE CHECKXAB =
 BEGIN

%IF INDX %THEN
 REGISTER
    XABPTR;			! POINTER TO THE USER XAB

 EXTERNAL
    DTPTABLE;		! KEY DATA-TYPE CHARACTERISTICS TABLE
 MAP
    DTPTABLE:	FORMAT;
 LOCAL
    TEMP,
    KRFCOUNT,		! COUNTER USED TO INSURE KRF'S ARE IN ORDER
    TOTALSIZE,		! ACCUMULATOR
    KEYBYTESIZE,		! BYTE SIZE OF THE KEY STRING
    AIDCOUNT,		! COUNT FOR THE SEQUENCING OF AID'S
    KSDPTR;			! POINTER TO KEY SEGMENT DESCRIPTOR


 MAP
    XABPTR:	POINTER,
    KSDPTR:	POINTER;

%([*** DONT COMPILE FOR VERSION 1***])%

	TRACE ('CHECKXAB');

	%([ GET THE START OF THE XAB CHAIN ])%

	XABPTR = .FAB [ FABXAB ];			! FETCH POINTER FROM FAB

	%([ INIT THE COUNTER OF THE CURRENT VALUE OF THE KRF ])%

	KRFCOUNT = ZERO;
	AIDCOUNT = 1;				! USE DEFAULT AREA TO START

	%([ WE MUST FIRST FIND THE AREA XABS AND CHECK THEM. THEN,
	   WE WILL SCAN FOR THE KEY XAB'S LATER. ])%

	WHILE .XABPTR ISNT ZERO
	DO
		BEGIN
		USRSTV = .XABPTR;			! SAVE ADDRESS OF BAD XAB
		IF  .XABPTR [ BLOCKTYPE ] ISNT XABCODE	! IS THIS AN XAB?
		THEN RETURNSTATUS (ER$XAB);		! NO
		IF .XABPTR [ XABCOD ] GTR MAXCOD	! VALID COD FIELD?
		THEN RETURNSTATUS (ER$COD);		! NO

		TEMP = .XABPTR [ XABNXT ];		! GET NEXT XAB ADDRESS
		IF ( .TEMP ISNT ZERO )
			AND
 		  ( .TEMP LEQ MINUSERBUFF )
			THEN  RETURNSTATUS (ER$NXT);	! BAD NEXT ADDRESS

		IF .XABPTR [ XABCOD ] IS CODAREA
		THEN
			BEGIN
			%([ CHECK THE SIZE OF THIS XAB ])%

			IF .XABPTR [ BLOCKLENGTH ] ISNT AREAXABSIZE THEN RETURNSTATUS (ER$BLN);

			IF .XABPTR [ XABAID ] ISNT .AIDCOUNT THEN RETURNSTATUS (ER$AID);
			IF ( .XABPTR [ XABBKZ ] GTR MAXBKZ )
				OR
			   ( .XABPTR [ XABBKZ ] IS ZERO )
			 THEN RETURNSTATUS (ER$BKZ);		! CHECK BUCKET SIZE
			AIDCOUNT = .AIDCOUNT + 1
			END; %(OF IF THIS IS AN AREA XAB)%
		XABPTR = .XABPTR [ XABNXT ]		! GO TO NEXT XAB
		END;	%(OF WHILE .XABPTR ISNT ZERO)%

	%([ NOW, WE WILL START ALL OVER AGAIN AND SEARCH FOR KEY XAB'S ])%

	XABPTR = .FAB [ FABXAB ];			! GET XAB CHAIN POINTER
	WHILE .XABPTR ISNT ZERO
	DO
		BEGIN

		USRSTV = .XABPTR;			! SAVE ADDRESS OF BAD XAB
		IF .XABPTR [ XABCOD ] IS CODKEY
		THEN %(THIS IS A KEY DEFINITION XAB)%

			BEGIN
			%([ CHECK THE SIZE OF THE XAB ])%

			IF .XABPTR [ BLOCKLENGTH ] ISNT KEYXABSIZE THEN RETURNSTATUS (ER$BLN);

			%([ CHECK THE DATA-TYPE OF THIS KEY ])%

			IF  .XABPTR [ XABDTP ] GTR MAXDTP
				THEN RETURNSTATUS (ER$DTP);

			%([ CHECK THAT THE KEY OF REFERENCES ARE IN ORDER ])%
 			IF .XABPTR [ XABREF ] ISNT .KRFCOUNT
				THEN RETURNSTATUS (ER$REF);

			%([ FIND THE BYTE SIZE FOR THIS KEY ])%

			KEYBYTESIZE = .DTPTABLE [ .XABPTR [ XABDTP ], DTPBYTESIZE ];
			IF .KEYBYTESIZE ISNT .FST [ FSTBSZ ]
			THEN
				RETURNSTATUS (ER$DTP);

			%([ CHECK THAT THE FLAGS DONT CONTRADICT ])%

			IF (( .XABPTR [ XABFLG ] AND FLGCHANGE ) ISON )
			THEN	%(KEYS CAN CHANGE...MAKE MORE CHECKS)%
				BEGIN
				IF     .KRFCOUNT IS REFPRIMARY
				THEN
					RETURNSTATUS (ER$FLG)
				END;	%(OF FLAGS CHECKS)%


			%([ CHECK THE INDEX AND DATA AREA NUMBER ])%

			IF .XABPTR [ XABIAN ] GEQ .AIDCOUNT
				THEN RETURNSTATUS (ER$IAN);
			IF .XABPTR [ XABDAN ] GEQ .AIDCOUNT
				THEN RETURNSTATUS (ER$DAN);


			%([ SET UP POINTER TO KEY SEGMENT
			   DESCRIPTORS ])%

			KSDPTR = .XABPTR + XABKSDOFFSET;
			TOTALSIZE = ZERO;
			INCR I FROM 0 TO MAXKEYSEGS-1
			DO
				TOTALSIZE = .TOTALSIZE
					       + .KSDPTR [ .I, KEYSIZ ];
			%([ CHECK THE LENGTH OF THE KEY ])%

			IF	( .TOTALSIZE GTR MAXKEYSIZE )
					OR
				( .TOTALSIZE IS ZERO )
			THEN RETURNSTATUS (ER$SIZ);

			KRFCOUNT = .KRFCOUNT + 1		! BUMP KRF TOTAL
			END; %(OF IF THIS IS A KEY XAB)%

		%([ CHECK THAT THIS WAS A VALID TYPE OF XAB ])%

		IF .XABPTR [ XABCOD ] GTR MAXCOD THEN RETURNSTATUS (ER$COD);
		IF .XABPTR [ BLOCKTYPE ] ISNT XABCODE
			THEN RETURNSTATUS (ER$XAB);

		%([ FETCH THE ADDRESS OF THE NEXT XAB IN THE CHAIN ])%

		XABPTR = .XABPTR [ XABNXT ]			! NEXT BLOCK
		END;	%( OF WHILE .XABPTR ISNT ZERO )%

	%([ NOW, CHECK THAT THERE ARE NOT TOO MANY KEY OR AREA XAB'S ])%

	USRSTV = 0;					!REMAINING ERRS NOT XAB SPECIFIC
	IF .KRFCOUNT GTR MAXKEYS+1 THEN RETURNSTATUS (ER$IMX);
	IF .AIDCOUNT GTR MAXAREAS THEN RETURNSTATUS (ER$IMX);
	IF .KRFCOUNT IS ZERO THEN RETURNSTATUS (ER$NPK);	! NO PRIMARY KEY

	%([ DID WE FIND AN ERROR DURING THIS ENTIRE PROCESS ])%

	GOODRETURN;
%FI

 END;	%( OF CHECKXAB )%

! CLEANUP
! =======

! ROUTINE TO CLEAN UP SOME OPERATIONS AFTER A $PUT HAS FAILED.
!	THIS ROUTINE MUST PERFORM THE FOLLOWING FUNCTIONS:
!
!		A. UNLOCK THE INDEX STRUCTURE
!		B. RELEASE THE CURRENT BUCKET
!
!	THE INDEX STRUCTURE IS UNLOCKED IF THE APPROPRIATE
!	BIT IS SET IN THE FST FLAGS FIELD. THE BUCKET DESCRIPTOR
!	IS RELEASED IF IT IS NON-NULL.

! INPUT:
!	BKTDESC			BUCKET DESCRIPTOR OF BUCKET TO RELEASE

! OUTPUT:
!	<NONE>

! NOTE:
!	1.	USRSTS MUST BE SET UP BY THE CALLER TO REFLECT THE
!		CORRECT ERROR CODE.
!	2.	THIS ROUTINE WILL RETURN OR NOT, DEPENDING UPON
!		THE VALUE OF OAFLAGS.

! ROUTINES CALLED:
!	LOCKIT
!	PUTBKT

GLOBAL ROUTINE CLEANUP ( BKTDESC ): NOVALUE =
 BEGIN

%IF INDX %THEN

 	ARGUMENT	(BKTDESC,BASEADD);	! CURRENT BUCKET

 MAP
    BKTDESC:	POINTER;
 LOCAL
    INDEXNUMBER;			! # OF CURRENT INDEX


	TRACE ('CLEANUP');

	%([ CHECK IF WE SHOULD UNLOCK THE INDEX ])%

	IF INDEXLOCKED
	THEN %(WE SHOULD)%
		UNLOCKINDEX;

	%([ SHOULD WE RELEASE THE CURRENT BUCKET ])%

	IF NOT NULLBD ( BKTDESC )
	THEN
		CALLPUTBKT (	%(NO UPDATE)%	PCI ( FALSE ),
				%(BKT )%		BPT ( BKTDESC ) );

	%([ SHOULD WE RETURN TO THE CALLER OR TO THE USER? ])%

	IF .OAFLAGS NEQ 0
	THEN
		RETURN
	ELSE
		USEXITERR;
%FI

 END; %(OF CLEANUP)%

! REMOVRECORD
! ============

! ROUTINE TO CLEAN-UP AFTER A $PUT FOR AN INDEXED FILE HAS FAILED
!	IN SOME WAY DURING PROCESSING OF THE SECONDARY INDEXES.
!	THIS ROUTINE DIFFERS FROM CLEAN-UP IN THAT IT IS MORE
!	SPECIALIZED...IT MUST DELETE THE DATA RECORD FROM SOME
!	OF THE SECONDARY INDEXES.
!	SPECIFICALLY, THIS ROUTINE DOES THE FOLLOWING:
!
!		1.  DELETE THE RECORD FROM ALL PREVIOUS SEC INDEXES
!		2.  COMPRESS THE DATA RECORD FROM THE DATA BUCKET.
!		3.  UNLOCK THE INDEX STRUCTURE OF THE FILE
!
!	IF ANY PROBLEM DEVELOPS DURING THE DELETION OF A SIDR
!	RECORD POINTER, THEN THE PRIMARY DATA RECORD WILL BE
!	MARKED WITH THE "DELETED" AND "NO-COMPRESS" BIT. THIS
!	MEANS THAT THE UDR WILL STAY AROUND FOREVER IF ANY OF
!	ITS SECONDARY INDEX ENTRIES CANNOT BE DELETED PROPERLY.


! INPUT:
!	RECDESC		RECORD DESCRIPTOR PACKET
!		RFA		RFA OF RECORD TO COMPRESS OUT
!
!	DATABD		BUCKET DESCRIPTOR OF DATA BUCKET
!	SIBD		BUCKET DESCRIPTOR OF SECONDARY INDEX (NOT USED NOW)

! OUTPUT:
!	<NONE>

! NOTES:
!	1.	KDB MUST POINT TO THE SEC INDEX KDB WHICH FAILED
!	2.	THE ERROR CODE MUST ALREADY BE SET UP IN USRSTS
!	3.	*****THIS ROUTINE EXITS DIRECTLY TO THE USER*****

GLOBAL ROUTINE REMOVRECORD ( RECDESC, DATABD ):NOVALUE =
 BEGIN

%IF INDX %THEN

 	ARGUMENT	(RECDESC,BASEADD);		! REC DESCRIPTOR
 	ARGUMENT	(DATABD,BASEADD);		! DATA BUCKET

 MAP
    RECDESC:	POINTER,
    DATABD:	POINTER;
 LABEL FLUSHSIDR;
 LABEL	SIDRLOOP;		! LOOP FOR ALL SIDR RECORD
 LOCAL
    FAILKDBADDRESS,		! ADDRESS OF BAD KDB
    OURBUFFER:	FORMATS[ MAXKSZW ],	! USE AS TEMP BUFFER
    USERRECORDPTR:	POINTER,		! PTR TO USER DATA RECORD
    SAVEDSTATUS,			! SAVED STATUS CODE
    SAVEDERRORCODE,			! ERROR CODE ON ENTRY
    FIXSIDRFLAG,			! TRUE IF ALL SIDR'S DELETED
    SAVEDRFA,			! REMEMBER THE RFA OF UDR
    SIZEOFTHISRCRD,		! FOR COMPRESSIONG
    AMOUNTTOMOVE;

 EXTERNAL ROUTINE
    LOCKIT,			! LOCKING ROUTINE
    DELUDR;			! SQUEEZE A UDR

 REGISTER
    TEMPAC,
    BKTPTR:	POINTER,		! PTR TO DATA BUCKET
    UDRPTR:	POINTER;		! PTR TO USER DATA RECORD


	TRACE ('REMOVRECORD');

	SAVEDERRORCODE = .USRSTS;		! SAVE THE PROPER CODE

	%([ SAVE THE BAD KDB ADDRESS AND SET UP SOME MISC. THINGS ])%

	FAILKDBADDRESS = .KDB;
	USERRECORDPTR = .RAB [ RABRBF ];
	RECDESC [ RDUSERPTR ] = OURBUFFER;		! ADDR OF KEY

	%([ LOOP OVER ALL KDB'S AND DELETE THE RECORD IN THAT INDEX ])%

	KDB = .FST [ FSTKDB ];				! PRIMARY INDEX
	KDB = .KDB [ KDBNXT ];				! FIRST SEC INDEX
	IF .KDB [ BLOCKTYPE ] ISNT KDBCODE THEN RMSBUG ( MSGKDB );

	FIXSIDRFLAG = TRUE;				! ASSUME WE SUCCEED

	%([ THIS IS THE LOOP ])%
SIDRLOOP:BEGIN

	UNTIL .KDB IS .FAILKDBADDRESS
	DO
		BEGIN

		%([ ONLY DELETE THE RECORD IF IT WAS INSERTED ])%

		IF .RAB [ RABRSZ ] GEQ .KDB [ KDBMINRSZ ]
				%(AND)%
		%(THIS IS NOT THE NULL KEY VALUE)%
		THEN
 FLUSHSIDR:		BEGIN

			%([ MOVE THE SEC KEY INTO A TEMP BUFFER ])%

			CALLMOVEKEY (	%(FROM)%	LPT ( USERRECORDPTR ),
					%(TO)%		LCT ( OURBUFFER ) );

			%([ SET UP THE KEY SIZE ])%

			RECDESC [ RDUSERSIZE ] = .KDB [ KDBKSZ ];

			%([ DELETE RECORD FROM SEC INDEX ])%

			IF 	CALLDELSIDR ( BPT ( RECDESC ) ) IS FALSE
			THEN
				LEAVE SIDRLOOP WITH ( FIXSIDRFLAG=FALSE)

			END; %(OF IF KEY WAS INSERTED INTO INDEX)%

		%([ ADVANCE TO NEXT KDB ])%

		KDB = .KDB [ KDBNXT ]
		END; %(OF UNTIL KDB IS FAILKDBADDRESS)%
	END; %(OF SIDRLOOP )%

	%([ NOW, GO BACK AND LOCATE THE USER DATA RECORD ])%

	KDB = .FST [ FSTKDB ];			! SET PRIMARY KEY
	RECDESC [ RDRECPTR ] = ZERO;			! START AT TOP
	RECDESC [ RDRFA ] = .RECDESC [ RDRRV ];		! SEARCH FOR NEW UDR

	!+							       !A55
	!   Locate the user data record with POSRFA, which will        !A55
        !   search for the newly inserted record by RFA, which was     !A55
        !   just placed in RECDESC [ RDRFA ].  SDATABKT was 	       !A55
        !   originally used here, but when the new record went into a  !A55
        !   separate bucket on a bucket split, SDATABKT would do an    !A55
        !   ID search of the current bucket and the wrong UDR would    !A55
        !   be deleted by REMOVRECORD.  			       !A55
	!-							       !A55

	IF CALLPOSRFA ( %(RD)%  BPT ( RECDESC ),		       !M55
			  %(BKT)% BPT ( DATABD  )) IS FALSE
	THEN RMSBUG ( MSGFAILURE );

	%([ IF WE DIDN'T FIND IT, THERE IS A PROBLEM, BECAUSE THE
	   BUCKET WAS NEVER UNLOCKED ])%


	%([ ***TAKE BEFORE IMAGE HERE*** ])%

	%([ GET THE ADDRESS OF THE DATA RECORD ])%

	UDRPTR = .RECDESC [ RDRECPTR ];
	RECDESC [ RDLENGTH ] = SIZEOFUDR (  UDRPTR );

	%([ IF WE SUCCESSFULLY DELETED ALL SECONDARY DATA RECORDS,
	   THEN WE CAN SQUEEZE OUT THE PRIMARY DATA RECORD.
	   IF NOT, WE CAN ONLY DELETE IF BUT MUST LEAVE IT INTACT
	   SO THAT AN EXISTING SECONDARY INDEX DOESN'T POINT TO A
	   NON-EXISTENT DATA RECORD. ])%

	IF .FIXSIDRFLAG ISNT FALSE
	THEN	%(WE CAN SQUEEZE)%

		CALLDELUDR (	%(RD)%		BPT ( RECDESC ),
				%(BKT)%		BPT ( DATABD ),
				%(LOCK)%	PCI ( TRUE ) )
	ELSE	%(WE CAN ONLY MARK THE RECORD AS DELETED)%

		SETFLAG ( UDRPTR [ DRFLAGS ], FLGDELETE+FLGNOCOMPRESS);


	%([ NOW, RELEASE THE DATA BUCKET AND UPDATE IT TO THE DISK...
	   (BECAUSE WE HAVE ALREADY WRITTEN IT TO THE DISK WHEN WE
	   THOUGHT THE OPERATION WOULD BE A SUCCESS) ])%

	CALLPUTBKT (	%(UPDATE)%	PCI ( TRUE ),
			%(BKT)%		BPT ( DATABD ) );

	%([ UNLOCK THE FILE INDEX STRUCTURE, IF IT WAS LOCKED ])%

	IF INDEXLOCKED THEN UNLOCKINDEX;

	%([ ***EXIT TO USER*** ])%

	USRSTS = .SAVEDERRORCODE;		! RESTORE CORRECT ERROR CODE
	USEXITERR;
%FI

 END; %(OF REMOVRECORD)%

! MAPCODES
! ========

! ROUTINE TO PERFORM ALL MAPPING OF TOPS-20 ERROR CODES (RETURNED
!	FROM MONITOR CALLS) TO THE APPROPRIATE RMS-20 ERROR CODES.
!	THIS ROUTINE SIMPLY TAKES THE TOPS-20 CODES WHICH WAS
!	RETURNED AND SEARCHES AN ERROR MAPPING TABLE SUPPLIED
!	BY THE CALLER TO DETERMINE IF THE SYSTEM ERROR CODE IS
!	IN THE TABLE. IF SO, THE CORRESPONDING RMS-20 ERROR CODE
!	IS SUBSTITUTED FOR THE SYSTEM ERROR CODE. IF NOT, THE
!	DEFAULT RMS-20 ERROR CODE IS STORED IN THE USER'S STS
!	FIELD (USRSTS) AND THE SYSTEM ERROR CODE IS STORED IN
!	THE STV FIELD.
!
!	THE FORMAT OF THE "ERROR MAPPING TABLE" (EMT) IS:
!
!		!-------------------------------------!
!		! <ASSOC-RMS-CODE> !  SYSTEM CODE-1   !
!		!-------------------------------------!
!		!                 .                   !
!		!-------------------------------------!
!		! <ASSOC-RMS-CODE> !  SYSTEM CODE-n   !
!		!-------------------------------------!
!		!                 0                   !
!		!-------------------------------------!


! INPUT:
!	SYSTEMCODE		CODE RETURNED BY TOPS-20
!	DEFAULTCODE		RMS-20 ERROR CODE TO BE USED BY DEFAULT
!	MAPTABLE		ADDRESS OF ERROR MAPPING TABLE

! OUTPUT:
!	<NO STATUS RETURNED>

! NOTES:
!
!	1.	THE SETTING OF "OAFLAGS" DETERMINES IF THIS ROUTINE
!		EXITS TO THE CALLER OR DIRECTLY TO THE USER.

! ROUTINES CALLES:
!	<NONE>

GLOBAL ROUTINE MAPCODES ( SYSTEMCODE, DEFAULTCODE, MAPTABLE ): NOVALUE =
BEGIN

	ARGUMENT	(SYSTEMCODE,VALUE);		! TOPS-20 CODE
	ARGUMENT	(DEFAULTCODE,VALUE);		! DEFAULT RMS CODE
	ARGUMENT	(MAPTABLE,BASEADD);		! ADDR OF MAP TABLE
MAP
    MAPTABLE:	POINTER;

REGISTER
    INDEX,				! USED TO INDEX INTO TABLE
    TABLEPTR:	POINTER;		! PTR TO MAPPING TABLE


	TRACE ('MAPCODES');

	%([ SET UP THE DEFAULT RMS-20 ERROR CODE IN USER STS FIELD ])%

	USRSTS = .DEFAULTCODE;
	USRSTV = .SYSTEMCODE;			! SAVE SYSTEM CODE

	%([ INITIALIZE INDEX VARIABLE ])%

	INDEX = ZERO;
	TABLEPTR = .MAPTABLE;			! GET ADDRESS OF TABLE

	%([ DO THIS LOOP FOR EACH ENTRY IN THE MAPPING TABLE.
	   WHEN THE END OF THE TABLE IS REACHED, WE CAN EXIT
	   BECAUSE WE HAVE ALREADY SET UP THE DEFAULT ERROR CODE ])%

	UNTIL .TABLEPTR [ .INDEX, WRD ] IS 0
	DO
		BEGIN

		%([ CHECK IF THIS ERROR CODE IS IN TABLE ])%

		IF .TABLEPTR [ .INDEX, EMTSYSCODE ] IS .SYSTEMCODE
		THEN	%(WE FOUND THE ERROR CODE)%
			(USRSTS = .TABLEPTR [ .INDEX , EMTRMSCODE ]; EXITLOOP);

		%([ BUMP THE TABLE INDEX ])%

		INC ( INDEX, SIZEOFEMTENTRY )

		END; %(OF UNTIL WE REACH THE END OF TABLE)%

	%([ RETURN TO USER OR CALLER ])%

	USEXITERR;

END;	%(OF MAPCODES)%
END
ELUDOM