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

MODULE  PUT =

BEGIN

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

%([

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

	$PUT			PROCESSOR FOR $PUT MACRO

	PUTASC			"PUT"'S RECORD TO ASCII FILE

	PUTSQR			"PUT"'S RECORD TO A SEQUENTIAL OR RELATIVE FILE

	PUTREC			PERFORMS PHYSICAL TRANSFER OF RECORD

	PUT			"PUT"'S RECORD TO INDEXED FILE

	SETPUT			SET-UP FOR $PUT TO INDEXED FILE





REVISION HISTORY:

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

1	7-OCT-76	SEB		MISC OPTIMIZATIONS
2	28-OCT-76	SEB		ADD RELEASECURRENTBUCKET MACRO
3	8-NOV-76	SEB		FIX BUG IN PUT TO REL FILE
4	23-NOV-76	SEB		FIX CHECK OF VALID BIT
5	7-FEB-77	SEB		FIX MAXRECORDSIZE COMP. IN SETPUT
					SO TOO BIG RECORDS ARE DETECTED
6	11-MAR-77	SEB		PUT CODE IN FOR CHECK BYTE
7	23-MAR-77	SEB		UNDO EDIT 6
8	5-APR-77	SEB		DON'T BLT FULL SIZE OF RELATIVE RECORD
9	6-APR-77	SEB		CHANGE HYBYTE TO RST FIELD

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

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

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

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

 103	  11	Dev		Indicate that a page has been updated before
				starting the next file page so that RMS
				will only do deferred writing when that option
				is enabled. (RMT, 12/2/85)

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




])%


FORWARD ROUTINE		PUTSQR,
		PUTREC: novalue;			! FORWARD DECLARATONS

EXTERNAL ROUTINE
    CHKDUP,			! CHECK DUPLICATE RECORDS
!    CHKMAP,			
    CKEYKK,			! COMPARE KEY STRINGS
    CRASH,
    DUMP,
    CLEANUP,		! CLEAN UP AFTER A BAD PUT OPERATION
    FOLLOWPATH,		! FOLLOW THE INDEX PATH
    INSRTUDR,		! INSERT A USER DATA RECORD
    INSRTSIDR,		! INSERT A SEC INDEX DATA RECORD
    IDXUPDATE,		! UPDATE THE INDEX STRUCTURE
    MAKIDX,			! CREATE AN INDEX STRUCTURE
    MOVEKEY,		! MOVE A KEY STRING TO A BUFFER
    NUMBERTORFA,
    PUTBKT,			! PUT A BUCKET
    SETNRP,			! SET UP THE NEXT RECORD POINTER
    GTBYTE,
    LOCKIT,
    MOVEREC,
!    MOVESTRING,
    NOSPAN,
    PUTASCII,
    PUTLSN,
    REMOVRECORD,		! TAKE UDR OUT OF FILE ON ERROR
    RSETUP;

EXTERNAL
    TBUFFER;		! TEMP BUFFER FOR KEY STRINGS

%([ EXTERNAL ERROR MESSAGES INVOKED WITHIN THIS MODULE ])%

EXTERNAL
    MSGFAILURE,		! ROUTINE FAILURE
!    MSGUNLOCKED,		! RECORD IS UNLOCKED
    MSGCANTGETHERE;		! LOGIC BUG
!    MSGASCII;		! ASCII FILE NOT DETECTED




REQUIRE 'RMSREQ';
EXTDECLARATIONS;

! $PUT
! ====

! PROCESSOR FOR $PUT MACRO

! INPUT:
!	ADDRESS OF USER RECORD BLOCK (RAB)
!	ADDRESS OF USER ERROR ROUTINE

! OUTPUT:
!	<STATUS FIELD OF USER RAB>

! ROUTINES CALLED:
!	PUTASCII
!	PUTSQR
!	PUTIDX
!	RSETUP

! FORMAT OF THE $PUT MACRO:
!
!		$PUT	<RAB-ADDRESS> [,<ERROR-ADDRESS>]
!
! RAB FIELDS USED AS INPUT BY $PUT:
!
!	ISI		INTERNAL STREAM IDENTIFIER
!	KBF		KEY BUFFER ADDRESS (RELATIVE/INDEXED)
!	KSZ		SIZE OF KEY IN KEY BUFFER (INDEXED)
!	LSN		LINE-SEQUENCE NUMBER (LSA)
!	RAC		RECORD ACCESS
!	RBF		ADDRESS OF USER RECORD BUFFER
!	ROP		RECORD ACCESS OPTIONS
!	RSZ		SIZE OF RECORD
!	

! RAB FIELDS WHICH ARE SET BY $PUT:
!
!	BKT		RECORD NUMBER OF CURRENT RECORD (RELATIVE)
!	RBF		ADDRESS OF BUFFER FOR NEXT RECORD (-11 COMPATIBILITY)
!	RFA		RECORD'S FILE ADDRESS
!	STS		COMPLETION STATUS CODE
!	STV		ADDITIONAL STATUS INFORMATION

GLOBAL ROUTINE %NAME('$PUT') ( BLOCK, ERRORRETURN ) =
BEGIN
	ARGUMENT (BLOCK,BASEADD);
	ARGUMENT (ERRORRETURN,BASEADD);		! ADDRESS OF USER ERROR ROUTINE
REGISTER
    ERRORCODE;				! USED TO SAVE AN ERROR CODE
%IF INDX %THEN
 EXTERNAL ROUTINE
	PUTIDX;
%FI

	RMSENTRY ( $PUT );

	%([ FETCH INPUT ARGS ])%

	RAB = .BLOCK;					! GET ADDRESS OF RAB
	ERRADR = .ERRORRETURN;		! AND USER ERROR ADDRESS
	CALLRSETUP ( PCI ( AXPUT ));			! DO OTHER STUFF





	%(***	 ERROR PROCESSING FOR $PUT MACRO   ***
	*						*
	* THE FOLLOWING ERRORS ARE CHECKED:		*
	*	1. RFA ADDRESSING IS ILLEGAL		*
	*	2. RECORD-SIZE < = MAX-REC-SIZE		*
	*	3. RECORD BUFFER MUST BE PROPER		*
	*	4. RECORD-SIZE FOR FIXED-LENGTH RECORDS	*
	*						*
	*						*
	*************************************************
	])%


	ERRORCODE = ZERO;				! ASSUME NO ERROR
	IF RFAADR THEN ERRORCODE = ER$RAC;			! DONT ALLOW RFA ADDRESSING
	IF  ( .FST [ FSTMRS ] ISNT ZERO )			! IF THERE IS A MAX RECORD SIZE...
	THEN	IF ( .RAB [ RABRSZ ]  GTR .FST [ FSTMRS ] )
		THEN ERRORCODE = ER$RSZ;			! RECORD IF BIGGER THAN MAXIMUM

	IF .RAB [ RABRBF ] LEQ MINUSERBUFF THEN ERRORCODE = ER$RBF;	! CHECK BUFFER

	IF FIXEDLENGTH
	THEN
		BEGIN
		IF .RAB [ RABRSZ ] ISNT .FST [ FSTMRS ] THEN ERRORCODE = ER$RSZ
		END;

	%([ WAS THERE AN ERROR? ])%

	IF .ERRORCODE ISNT ZERO 
	THEN
		BEGIN
		USRSTS = .ERRORCODE;
		USEXITERR				! EXIT FROM RMS
	END;


	%([ *****  END OF ERROR PROCESSING FOR $PUT ****** ])%




	%([ DISPATCH TO A ROUTINE TO WRITE A RECORD FOR EACH FILE ORGANIZATION ])%

	CASE FILEORG FROM 0 TO 4 OF
		SET
		
		[0]:	%( ASCII )%	CALLPUTASCII;		! ASCII FILE
		[1]:	%( SEQ )%		CALLPUTSQR;		! SEQUENTIAL FILE
		[2]:	%( REL )%		CALLPUTSQR;		! RELATIVE FILE
		[3]:	%( INDX )%	%IF INDX %THEN
					CALLPUTIDX;		!INDEXED FILE
					%FI
		
		[4]:	
		TES;	%( END OF CASE FILEORG )%


	%([ SET THE "SUCCESS" BIT AND REMEMBER THAT THIS WAS A $PUT ])%

	SETSUCCESS;					! SET SUCCESS BIT AND LAST-OPER

	%([ RETURN THE RFA OF THIS RECORD TO THE USER ])%

	RAB [ RABRFA ] = .RST [ RSTDATARFA ];

	%([ EXIT TO THE USER ])%

	USEREXIT	%( EXIT TO USER )%


END; %( OF $PUT PROCESSOR )%

! PUTSQR
! ======

! THIS ROUTINE PROCESSES THE $PUT VERB TO A SEQUENTIAL OR RELATIVE
! FILE

! INPUT:
!	<NONE>

! OUTPUT:
!	<NONE>
!

GLOBAL ROUTINE PUTSQR  =
BEGIN


LOCAL
    TEMP1,
    BYTENUM,				! BYTE NUMBER OF TARGET RECORD
    HEADER,
    CRP;					! SAVE FOR ARA
REGISTER
    FULLRECORDSIZE;

	TRACE ( 'PUTSQR' );

	%([ FIND THE CRP AND BYTE-ADDRESS OF THE CURRENT RECORD FOR EACH FILE TYPE ])%

	%([ WE MUST PERFORM DIFFERENT OPERATIONS HERE DEPENDING
	   UPON THE FILE ORGANIZATION. HERE IS A SUMMARY OF
	   THE ACTIONS WHICH ARE DONE BELOW:


	   ASCII FILES:
		IF THIS IS AN ASCII FILE, THEN WE SHOULD NOT BE HERE, MUST BE A BUG.

	   SEQUENTIAL FILES:
		FOR SEQUENTIAL FILES, WE FIRST MUST COMPUTE THE SIZE
		OF THIS RECORD IN WORDS. THIS QUANTITY IS COMPUTED HERE
		BECAUSE IT IS USED HEAVILY LATER AND WE WOULD LIKE NOT
		TO HAVE TO RE-COMPUTE IT SEVERAL TIMES.  THEN, WE MUST
		DETERMINE IF THIS RECORD CAN FIT ON THE PAGE IF THE
		FB$BLK ATTRIBUTE IS DEFINED FOR THE FILE.

	   RELATIVE FILES:
		WE MUST FETCH EITHER THE NRP OR THE USER'S RECORD
		KEY, DEPENDING UPON HIS RECORD-ACCESS FIELD. THIS
		VALUE WILL THEN BE MAPPED INTO AN RFA WHICH GIVES
		THE STARTING ADDRESS OF THE TARGET RECORD. ])%

	%([ COMPUTE THE SIZE IN WORDS OF THIS RECORD ])%

	RST [ RSTRSZW ] = SIZEINWORDS ( .RAB [ RABRSZ ], .FST [ FSTBSZ ] );

	CASE FILEORG FROM 0 TO 3 OF

		SET
		[0]:	%(ASCII)%	0;	! SHOULD NOT GET HERE

		[1]:	%(SEQ)%		BEGIN

					CRP = .RST [ RSTNRP ] ;		! GET NRP

					%([ IF FILE IS BLOCKED, SEE IF RECORD
					    CAN FIT ON THIS PAGE ])%

					IF BLOCKED
					THEN				! CHECK TO SEE IF RECORD CAN FIT ON PAGE
						CRP =CALLNOSPAN ( LCI ( CRP ) );
					BYTENUM = .CRP			! GET FILE ADDRESS
					END; %( OF CASE SEQUENTIAL FILE )%

		[2]:	%(REL)%		BEGIN
					CRP = ( CASE RECORDACCESS FROM 0 TO 1 OF

						SET
						[0]:	%(SEQ)%	.RST [ RSTNRP ] ;		! FETCH NRP

						[1]:	%(KEY)%	BEGIN
								IF .RAB [ RABKBF ] LSS MINUSERBUFF THEN USERERROR ( ER$KBF );
								..RAB [ RABKBF ]
								END
						TES); %( END OF CASE ADRMODE )%

					IF ( BYTENUM = CALLNUMBERTORFA ( LCI ( CRP ) ) )	! COMPUTE BYTE-# OF RECORD
						IS FALSE THEN USERERROR ( ER$KEY )		! RECORD WAS .GTR. MRN

					END; %( OF RELATIVE FILE )%

		[3]:	
		TES; %( END OF CASE FILEORG OF SET )%

	%([ AT THIS POINT, WE HAVE THE FOLLOWING VALUES:
		CRP	=	RFA OF THE RECORD TO BE WRITTEN
		BYTENUM	=	BYTE ADDRESS OF RECORD ])%

	%([ SET UP SOME VALUES WHICH WE WILL USE LATER SO THEY
	   CAN BE IN REGISTERS TO SAVE TIME ])%

	FULLRECORDSIZE = .RST [ RSTRSZW ];			! SIZE OF ENTIRE RECORD

	%([ MAKE SURE THE RECORD CAN FIT ON ONE PAGE IF BLOCKED ])%

	IF BLOCKED
	THEN IF ( ( .FULLRECORDSIZE + HEADERSIZE ) GTR PAGESIZE ) THEN USERERROR ( ER$RSZ );

	%([ PRINT OUT THE RESULTS FOR DEBUGGING ])%

	LOOKAT ( '	BYTE NUMBER OF REC: ', BYTENUM );
	LOOKAT ( '	CURRENT REC PTR:: ', CRP );

	%([ UNLOCK CURRENT RECORD ])%

	IF DATALOCKED THEN UNLOCK ( RST [ RSTDATARFA ] );	! UNLOCK THE CURRENT RECORD

	%([ MAKE CRP EQUAL TO NRP ])%

	RST [ RSTDATARFA ] =  .CRP;				! CRP = NRP

	%([ LOCK THE RECORD TO BE WRITTEN ])%

	IF LOCKING THEN LOCKREC ( CRP );				! LOCK THE RECORD

	%([ THE RECORD IS NOW LOCKED ( IF FILE-SHARING )
	HOWEVER, IT MAY NOT BE IN OUR BUFFER SO
	WE MUST GET IT THERE AND SET UP THE
	POINTER TO IT ( PAGPTR ) WITHIN THE WINDOW PAGE ])%


	%([ POSITION THE FILE TO THE CORRECT RECORD ])%

	CALLGTBYTE ( LCI ( BYTENUM ), PCI ( FALSE ));		! FETCH FILE PAGE INTO USER WINDOW

	%([ THE PAGE IS NOW IN THE BUFFER AND PAGPTR POINTS TO IT ])%

	HEADER = .( .RST [ RSTPAGPTR ] );			! GET RECORD HEADER
	IF ( SEQFILE AND ( .HEADER  ISNT ZERO ) ) THEN USERERROR ( ER$NEF );	! ATTEMPT TO INSERT RECORD

	%([ FOR RELATIVE FILES, THE RECORD CAN BE WRITTEN EXCEPT
	   IN THE CASE WHERE THE RECORD IS VALID, BUT NOT DELETED.
	   THEREFORE, WE MUST CHECK BOTH THE VALID AND THE DELETED
	   BITS IN THE RECORD HEADER. ])%

	IF RELFILE
	THEN	%(CHECK FOR NON-DELETED RECORD)%
		BEGIN
		IF ( CHKFLAG ( HEADER, RHDRVALID+RHDRDELETE ) )
				IS
			( RHDRVALID )
		THEN
			USERERROR ( ER$REX );
		RAB [ RABBKT ] = .CRP			! RETURN RECORD NUMBER
		END; %(OF IF RELFILE)%


	%([ NOW, MOVE THE RECORD ONTO THE FILE PAGE ])%

	CALLPUTREC;						! MOVE RECORD

	%([ UPDATE THE HIGHEST BYTE IN THE FILE ])%

	TEMP1 = .BYTENUM + .FULLRECORDSIZE + HEADERSIZE;	! COMPUTE WHERE NEXT RECORD IS
	IF .TEMP1  GTR .RST [ RSTHYBYTE ]			! IF THIS RECORD IS HIGHER THAN ANY PREVIOUS ONE...
	THEN BEGIN
		RST [ RSTHYBYTE ] = .TEMP1;			! RESET EOF BYTE
		SIZEOFFILE = .TEMP1;				! CROCK
	END;


	%([ UPDATE THE NEXT RECORD POINTER ])%

	IF SEQADR THEN RST [ RSTNRP ] =
	( IF SEQFILE THEN .CRP + HEADERSIZE  + .FULLRECORDSIZE	! NRP = OLD NRP + SIZE OF HEADER + SIZE OF RECORD
		ELSE .CRP + 1 );				! BUMP RECORD NUMBER FOR RELATIVE FILES

	%( NOW RELEASE ANY LOCKED RECORD )%
	IF DATALOCKED THEN UNLOCK ( RST [ RSTDATARFA ] );	! UNLOCK THE RECORD

	GOODRETURN

END;	%( OF PUTSQR )%

! PUTREC
! ======

! THIS ROUTINE CREATES A RECORD IN A RMS-20 FILE. IT IS
!	ASSUMED ON INPUT THAT PAGPTR POINTS TO THE
!	CORRECT PLACE ON THE CURRENT WINDOW PAGE AT WHICH TO
!	WRITE THE RECORD. THERE MUST BE NO OVERLAP PAST
!	THE END OF THE WINDOW PAGE ON INPUT.
!	ON OUTPUT, PAGPTR WILL BE CLOBBERED.

! INPUT:
!	<NONE>

! OUTPUT:
!	<NO STATUS RETURNED>

! GLOBALS USED:
!	GTBYTE
!	MOVEREC

GLOBAL ROUTINE PUTREC: NOVALUE  =
BEGIN

LOCAL
    COUNT,
    BYTESIZE,
    DUMMYLOCAL,		! USED TO PASS SUBROUTINE ARGS
    NEWPAGE,
    USERBUFF;

REGISTER
    RECORDPTR,
    TEMP,
    BLTAC;

MAP
    RECORDPTR:	POINTER;


	TRACE ( 'PUTREC' );

	%([ CHECK VALIDITY OF A FEW THINGS ])%

	RECORDPTR = .RST [ RSTPAGPTR ];				! FETCH POINTER

	%([ WRITE HEADER ])%

	RECORDPTR [ WHOLEWORD ] = .RAB [ RABRSZ ] + RHDRVALID;	! RECORD-SIZE + VALID


	%([ WE HAVE NOW WRITTEN THE HEADER FOR THIS RECORD.
	   WE MUST BUMP THE FILE POINTER AND CHECK TO SEE
	   IF WE ARE PAST THE END OF THE FILE BUFFER. IF SO,
	   WE WILL MAP IN THE NEXT PAGE OF THE FILE AND WRITE
	   THE REST OF THE RECORD ])%

	RECORDPTR = .RECORDPTR + 1;				! BUMP FILE POINTER
	IF ( .RECORDPTR AND OFSETMASK ) IS ZERO
	THEN %( WE OVERLAPPED )%

		BEGIN	%( TO MAP NEXT PAGE )%
		SETBFDUPD (CBD [BKDBFDADR]);		! INDIC FILE PAGE UPD
		NEWPAGE = (( .CURRENTFILEPAGE +1 ) ^ P2W );	! GET START OF NEXT FILE PAGE


		%([ POSITION THE FILE ])%
		CALLGTBYTE ( LCI ( NEWPAGE ),	%( RFA OF NEXT PAGE )%
			       PCI ( FALSE ));		%( NO ABORT )%

		RECORDPTR = .RST [ RSTPAGPTR ]		! RESET POINTER
		END;	%( OF IF OFFSET IS ZERO )%




	%([ WE ARE NOW READY TO MOVE THE RECORD TO THE FILE.
	   HOWEVER, IN MOST CASES THE RECORD WILL FIT ENTIRELY
	   ON THE CURRENT FILE PAGE. IF THIS IS THE CASE, WE
	   DON'T NEED TO PERFORM ALL THE PAGE TURNING THAT
	   "MOVEREC" CAN DO; SO, A QUICK BLT IS ALL WE NEED.
	   THEREFORE, IF THIS RECORD DOES NOT SPAN FILE PAGES,
	   WE WILL DO THE MOVE HERE; OTHERWISE, WE WILL CALL
	   "MOVEREC" TO DO IT FOR US. ])%

	BYTESIZE = .FST [ FSTBSZ ];			! BYTE SIZE OF RECORD TO MOVE
	COUNT = .RAB [ RABRSZ ];			! SIZE OF RECORD
	USERBUFF = .RAB [ RABRBF ];			! GET USER ADDRESS
	TEMP = .RST [ RSTRSZW ];			! GET RSZW INTO AC
	IF ( ( .RECORDPTR AND OFSETMASK ) + .TEMP ) LSS PAGESIZE
	THEN %(THIS RECORD DOES NOT SPAN PAGE BOUNDARIES)%

		BEGIN
		SETBFDUPD(CBD[BKDBFDADR]);		!INDIC FILE PAGE UPD
		MOVEWORDS (	%(FROM)%	.USERBUFF,
				%(TO)%	.RECORDPTR,
				%(SIZE)%	.TEMP );

		RETURN
		END; %( OF IF THIS RECORD DOESNT SPAN PAGES )%

	%([ SET UP TO MOVE THE RECORD, IF IT SPANS PAGES ])%

	DUMMYLOCAL = .RECORDPTR;		! STORE IN LOCAL VARIABLE
	CALLMOVEREC (	LCI ( DUMMYLOCAL ),	%( WINDOW PTR )%
			LCI ( USERBUFF ),	%( USER BUFFER )%
			PCI ( TRUE ),		%( PUT-FLAG )%
			LCI ( COUNT ),		%( SIZE )%
			LCI ( BYTESIZE ) );	%( GUESS WHAT )%



	RETURN



END;	%( OF PUTREC )%

! PUTIDX
! ======

! ROUTINE TO INSERT A USER DATA RECORD INTO AN INDEXED FILE. ON
!	ENTRY TO THIS ROUTINE, NO PREPARATION OR RECORD UNLOCKING
!	HAS BEEN DONE. 

! INPUT:
!	<NONE>

! OUTPUT:
!	<NONE>

! ROUTINES CALLED:
!	FOLLOWPATH
!	INSRTUDR
!	IDXUPDATE
!	INSRTSIDR
!	REMOVRECORD

GLOBAL ROUTINE PUTIDX: NOVALUE =
 BEGIN

%IF INDX %THEN
 
 EXTERNAL ROUTINE
	PUTSIDR,				! PUT A SECONDARY RECORD
	SETPUT;					! SET UP ROUTINE FOR PUT
 LOCAL
	RESULT,
	RECDESC:	FORMATS[ RDSIZE ],	! RECORD DESCRIPTOR PACKET
	SECRECDESC:	FORMATS[ RDSIZE ],		!  RECORD DESCIPTOR PACKET FOR SEC INDEX
	BKTDESC:		FORMATS[ BDSIZE ],		! BUCKET DESCRIPTOR OF DATA
	SPLITBD1:	FORMATS[ BDSIZE ],		! BUCKET DESCRIPTOR FOR 1ST EXTRA BUCKET
	SPLITBD2:	FORMATS[ BDSIZE ],		! "         "      " 2ND EXTRA BUCKET
	ROOTBD:		FORMATS[ BDSIZE ],		! BUCKET DESC FOR INDEX ROOT
	TEMPPTR:	POINTER,			! PTR TO PROPER BUCKET DESCRIPTOR
	USERRECORDPTR:	POINTER,			! PTR TO THE USER'S RECORD
	ADDRESSOFRECORD	,			! SAVE LOCATION OF NEW RECORD HERE
	KEYOFREFERENCE	,				! CURRENT KEY VALUE
	DATAPAGE	;				! DATA PAGE NUMBER
 

%([ DONT COMPILE FOR VERSION 1 ])%

	TRACE ( 'PUTIDX');

	%([ SET UP THE ADDRESS OF THE USER'S DATA RECORD ])%

	USERRECORDPTR = .RAB [ RABRBF ];

	%([ SET UP THE ARGUMENTS FOR THE PUT INDEXED OPERATION ])%

	CALLSETPUT ( LCT ( RECDESC ) );

	%([ SET OUR BUCKET DESCRIPTOR TO BE NULL ])%

	SETNULLBD ( BKTDESC );

	%([***** LOCK THE ENTIRE INDEX DURING OUR OPERATION ***** ])%

	IF LOCKING
	THEN
		BEGIN
		IF LOCKINDEX (ENQBLK, ENQEXC) IS FALSE
		THEN  USERERROR ( ER$EDQ )
		END; %(OF IF LOCKING)%

	%([ BEFORE WE INSERT THE RECORD, WE MUST CHECK TO MAKE
	   SURE THAT THIS KEY HAS AN INDEX STRUCTURE ])%

	IF NOINDEXFLAG ISON
	THEN %(WE MUST CREATE AN INDEX ROOT AND A FIRST DATA BUCKET )%
		BEGIN
		CALLMAKIDX;			! MAKE THE INDEX

		%([ WE MUST NOW CHECK TO SEE IF THERE STILL ISN'T
		   AN INDEX FOR THIS KEY. THIS COULD BE TRUE IF
		   A FILE WITHOUT AN INDEX WAS OPENED, BUT SOMEONE
		   ELSE CREATED AN INDEX BEFORE WE DID. ])%

		IF NOINDEXFLAG ISON
		THEN %(THERE WAS AN ERROR)%
			CALLCLEANUP ( %(BKT)%	LCT ( BKTDESC ) )
		END; %(OF IF NOINDEX FLAG IS SET)%

	%([ INSERT THE DATA RECORD INTO THE PRIMARY INDEX ])%

	IF 	CALLFOLLOWPATH (	%(REC DESC)%	LCT ( RECDESC ),
				%(BUCKET)%	LCT ( BKTDESC )) IS FALSE

	%([ IF WE COULDN'T LOCATE THE DATA BUCKET, THEN WE MUST
	   EXIT WITH FAILURE. HOWEVER, IF THE SEARCH KEY IS .GTR.
	   THAN ALL KEYS IN THE BUCKET, THEN THAT IS A REASONABLE
	   SITUATION.  ])%

	THEN CALLCLEANUP ( %(BKT)%	LCT ( BKTDESC ) );


	%([ CHECK FOR DUPLICATE RECORD ])%

	RESULT =  CALLCHKDUP (	%(REC DESC)%	LCT ( RECDESC ),
			%(BUCKET)%	LCT ( BKTDESC ) );


	%([ WE NOW HAVE LOCATED THE POSITION WHERE THE NEW RECORD
	   IS TO BE INSERTED. HOWEVER, WE MUST DETERMINE IF
	   SOME OTHER PROCESS ALREADY HAS THE BUCKET LOCKED. ])%

	IF .RESULT ISNT FALSE	%(DID CHKDUP SUCCEED?)%
	THEN IF LOCKING
		THEN
		BEGIN	%(TO LOCK THE BUCKET)%
		RESULT = LOCKBD ( BKTDESC, ENQAA, ENQEXC )	! DON'T WAIT FOR BUCKET
		END;	%(OF IF LOCKING)%


	%([ THE RECPTR FIELD IN THE RECORD-DESCRIPTOR NOW CONTAINS
	   THE ADDRESS WHERE WE WANT TO WRITE OUR NEW RECORD. ])%

	IF .RESULT ISNT FALSE %(IF CHKDUP SAID WE CAN GO ON)%
	THEN
		RESULT = CALLINSRTUDR (	%(REC-DESC)%	LCT ( RECDESC ),
				%(REC)%		LPT ( USERRECORDPTR ),
				%(BUCKET)%	LCT ( BKTDESC ),
				%(EXTRA-1)%	LCT ( SPLITBD1 ),
				%(EXTRA-2)%	LCT ( SPLITBD2 ) );

	%([ IF EITHER CHKDUP, LOCKIT, OR INSRTUDR RETURNED AN ERROR, WE
	   MUST CLEAN UP OUR OPERATIONS. ])%

	IF .RESULT IS FALSE THEN
		CALLCLEANUP (	%(BUCKET)%	LCT ( BKTDESC ));

 	%([ WE MUST NOW SAVE THE ADDRESS WITHIN THE DATA BUCKET OF THE
 	   THE RECORD WE JUST INSERTED ])%

	ADDRESSOFRECORD = .RECDESC [ RDRECPTR ];



	%([** IF IT IS SEQ $PUT AND A BUCKET SPLIT(ONE WAY) OCCURRED **])%
	%([** WITH R-NEW GOING TO A NEW BUCKET, THEN THE ORIG BKT WAS **])%
	%([** FLUSHED IN INSRTUDR SO WE MUST MAKE THE SPLIT BUCKET   **])%
	%([** THE CURRENT BKT...				     **])%

	IF SEQADR		! SEQ ACCESS
	THEN
		IF FLUSHORIGBD ( RECDESC ) ISON
		THEN
			BEGIN
			MOVEBKTDESC ( %(FROM)% SPLITBD1,
				      %(TO)% BKTDESC );
			CLRFLAG ( RECDESC [ RDSTATUS ], RDFLGNEWINNEW );
			END;



	%([ AT THIS POINT, BOTH THE DATA BUCKET AND THE INDEX
	   ARE STILL LOCKED. WE MUST UPDATE THE INDEX STRUCTURE
	   (IF NECESSARY) AND THEN UNLOCK ALL THESE BUCKETS ])%

	IF IDXUPDATEFLAG ( RECDESC ) ISON
	THEN %(WE MUST UPDATE THE INDEX)%

		BEGIN
		IF 	CALLIDXUPDATE (	%(REC DESC)%	LCT ( RECDESC ),
				%(BUCKET)%	LCT ( BKTDESC ),
				%(EXTRA-1)%	LCT ( SPLITBD1 ),
				%(EXTRA-2)%	LCT ( SPLITBD2 ) )  IS FALSE
		THEN SETIDXERRORFLAG ( RECDESC )		! REMEMBER THE ERROR
		END; %(OF IF WE MUST UPDATE THE INDEX)%


	%([ MOVE THE RFA OF THIS RECORD INTO THE RRV ADDRESS 
	   IN THE RECORD DESCRIPTOR PACKET, AND INTO THE CURRENT
	   RP ADDRESS IN THE RST (SO IT CAN BE RETURNED TO THE
	   USER ON RETURN FROM PUTIDX) ])%

	RST [ RSTDATARFA ] = (SECRECDESC [ RDRRV ] = .RECDESC [ RDRFA ] );	! MOVE RFA TO RRV
	SECRECDESC [ RDSTATUS ] = .RECDESC [ RDSTATUS ];	! SAVE STATUS BITS

	%([ LOOP OVER ALL KEY DESCRIPTORS ])%

	KEYOFREFERENCE = REFPRIMARY;			! INITIALIZE TO 0
	WHILE ( KDB = .KDB [ KDBNXT ] ) ISNT ZERO
	DO %(THIS LOOP)%

		BEGIN

		%([ BUMP THE CURRENT KEY OF REFERENCE ])%

		INC ( KEYOFREFERENCE, 1 );

		%([ MAKE SURE RECORD IS LONG ENOUGH TO CONTAIN 
		   THIS SECONDARY KEY VALUE ])%

		IF .RAB [ RABRSZ ] GEQ .KDB [ KDBMINRSZ ]
				%(AND)%
		   %(THIS KEY IS NOT THE NULL KEY VALUE)%
		THEN
			BEGIN %(TO INSERT RECORD INTO THIS SEC INDEX)%

			RTRACE (%STRING('	INSERTING RECORD INTO SEC IDX',%CHAR(13),%CHAR(10)));

			%([ INSERT THIS RECORD IN THE SECONDARY INDEX ])%

			IF 	CALLPUTSIDR ( LCT ( SECRECDESC ) )  IS FALSE
			THEN
				CALLREMOVRECORD (	LCT ( RECDESC ),
							LCT ( BKTDESC ) );

			%([ WE MUST NOW MOVE THE FLAGS FROM THIS RECORD
			   DESCRIPTOR INTO THE PRIMARY RECORD DESCRIPTOR.
			   THUS, IF WE SAW EITHER AN INDEX ERROR OR A
			   DUPLICATE SECONDARY, WE MUST REMEMBER IT. ])%

			SETFLAG ( RECDESC [ RDSTATUS ], .SECRECDESC [ RDSTATUS ] )

			END %(OF RECORD IS TO BE INSERTED)%

		END; %(OF WHILE KDB ISNT ZERO)%


	%([ RECORD HAS BEEN INSERTED INTO ALL INDEXES ])%

	RTRACE (%STRING('	RECORD HAS BEEN INSERTED',%CHAR(13),%CHAR(10)));

	%([ UPDATE NRP IF THIS WAS A $PUT SEQUENTIAL ])%

	KDB = .FST [ FSTKDB ];				! SET UP FOR PRIM KEY
	RECDESC [ RDRECPTR ] = .ADDRESSOFRECORD;	! RESTORE LOC OF RECORD



%([**	UPDATE NRP IF THIS WAS A $PUT SEQ		**])%

	IF SEQADR 	! SEQUENTIAL ACCESS
	THEN
		CALLSETNRP ( LCT ( RECDESC ), LCT ( BKTDESC ) );



	%([ CHECK FOR DUPLICATE RECORDS ])%

	IF SAMEKEYFLAG ( RECDESC ) ISON THEN USRSTS = SU$DUP;

	%([ CHECK FOR INDEX UPDATE ERRORS ])%

	IF IDXERRORFLAG ( RECDESC ) ISON THEN USRSTS = SU$IDX;

	%([ GIVE THE DATA BUCKET BACK (IT HAS ALREADY BEEN WRITTEN TO THE FILE ])%

	CALLPUTBKT (	%(NO UPDATE)%	PCI ( FALSE ),
			%(BKT)%		LCT ( BKTDESC ) );


	%([ UNLOCK THE INDEX STRUCTURE OF THE FILE SO OTHER PROCESSES
	   CAN TRAVERSE THE INDEX. ])%

	IF LOCKING THEN UNLOCKINDEX;

	%([ RETURN TO THE $PUT DISPATCHER ])%

	RETURN
%FI
 END; %(OF PUTIDX)%

! SETPUT
! ======

! ROUTINE TO SET UP THE RECORD DESCRIPTOR PACKET FOR A
!	$PUT TO AN INDEXED FILE. THIS ROUTINE PERFORMS
!	THE FOLLOWING OPERATIONS:
!
!	1.	SET UP THE KEY DESCRIPTOR BLOCK POINTER
!	2.	CHECK THE LAST USER KEY IF THIS IS A $PUT SEQ
!	3.	CHECK THE USER RECORD SIZE
!	4.	COMPUTE THE WORD SIZE (RSZW) OF THE RECORD AND STORE IT
!	5.	MOVE THE KEY INTO A TEMPORARY BUFFER
!	6.	CHECK FOR OUT-OF-SEQUENCE KEY STRING

! INPUT:
!	RECDESC		=	RECORD DESCRIPTOR PACKET

! OUTPUT:
!	<NO STATUS RETURNED>

! FIELDS IN THE RECORD DESC. WHICH ARE MODIFIED:
!	USRSIZE		=	SIZE OF USER KEY STRING
!	USERPTR		=	ADDRESS OF PRIMARY KEY STRING

! ROUTINES CALLED:
!	CKEYUI

GLOBAL ROUTINE SETPUT ( RECDESC ) =
 BEGIN

%IF INDX %THEN
 	ARGUMENT	(RECDESC,BASEADD);
 
 MAP
	RECDESC:	POINTER;
 LOCAL
	DATARECORDPTR:	FORMAT,		! ADDR OF USER DATA RECORD
	CBKDPTR:	POINTER,	! PTR TO CURRENT BUCKET DESC
	LASTKEYBUFF;	
 
 REGISTER
	MAXRECORDSIZE,			! MAX SIZE OF USER DATA RECORD
	TEMPAC	,
	RECORDSIZE;				! CURRENT SIZE OF USER DATA RECORD
 

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

	TRACE ( 'SETPUT' );

	%([ SET UP THE KDB POINTER FOR PRIMARY KEY ])%

	KDB = .FST [ FSTKDB ];

	%([ RELEASE THE CURRENT BUCKET, IF ANY ])%

	RELEASCURENTBKT;

	%([ CHECK IF USER'S RECORD IS TOO BIG FOR A BUCKET ])%

	MAXRECORDSIZE = ( .KDB [ KDBDBKZ ] ^ B2W );	! SIZE OF BUCKET
	MAXRECORDSIZE = .MAXRECORDSIZE - BHHDRSIZE - .KDB [ KDBHSZ ];
	RECORDSIZE = ( RST [ RSTRSZ ] =  .RAB [ RABRSZ ] );	! GET RECORD SIZE

	IF ( RST [ RSTRSZW ] = ( RECDESC [ RDLENGTH ] =  SIZEINWORDS (  .RECORDSIZE, .FST [ FSTBSZ  ] ) ) )
		GTR .MAXRECORDSIZE THEN USERERROR ( ER$RSZ );

	%([ CHECK THAT THE RECORD CONTAINS THE PRIMARY KEY ])%

	IF .RECORDSIZE LSS .KDB [ KDBMINRSZ ] 
	THEN %(THE PRIMARY KEY IS NOT IN THE RECORD)%
		USERERROR ( ER$RSZ );

	%([ WE WILL NOW MOVE THE PRIMARY KEY TO A TEMPORARY
	   BUFFER TO SAVE TIME ])%

	DATARECORDPTR = .RAB [ RABRBF ];

	CALLMOVEKEY (	%(FROM)%	LPT ( DATARECORDPTR ),
			%(TO)%	GCT ( TBUFFER ) );

	%([ SET UP THE RECORD DESCRIPTOR TO INDICATE THAT THE
	   KEY STRING RESIDES IN OUR TEMPORARY BUFFER ])%

	%([ ***NEXT INSTR. ASSUMES THAT RDFLAGS AND RDSTATUS ARE
	   IN WORD 0 ********* ])%

	RECDESC [ WHOLEWORD ] = ZERO;
	RECDESC [ RDUSERPTR ] = TBUFFER;
	RECDESC [ RDUSERSIZE ] = .KDB [ KDBKSZ ];	! USE FULL KEY SIZE

	%([ IF THIS IS A SEQUENTIAL $PUT OPERATION, WE MUST CHECK
	   THAT THE CURRENT KEY IS HIGHER THAN THE LAST KEY USED ])%

	IF SEQADR
	THEN
		BEGIN

		%([ IF THE LAST OPERATION WAS ALSO A $PUT SEQUENTIAL,
		   THEN WE MUST COMPARE THE KEYS ])%

		IF .RST [ RSTLASTOPER ] IS C$PUT
		THEN IF ( CHKFLAG ( RST [ RSTFLAGS ], FLGLASTSEQ ) ISON )
		THEN
			BEGIN
			LASTKEYBUFF = .RST [ RSTKEYBUFF ];	! GET ADDR OF LAST KEY
			IF CALLCKEYKK (	%(REC DESC)%	BPT ( RECDESC ),
					%(LAST KEY)%	LPT ( LASTKEYBUFF ) ) IS TRUE

			%([ IS THIS KEY GTR THAN THE LAST ONE? ])%

			%([ NOTE THAT CKEYKK RETURNS TRUE ONLY IF THE
			   SEARCH KEY IS LEQ THE TARGET KEY, THUS WE
			   ACTUALLY WANT THIS ROUTINE TO FAIL FOR OUR
			   KEY COMPARISON ])%

			THEN USERERROR ( ER$SEQ )
			END;	%(OF IF LAST OPER WAS PUT AND LASTSEQ ISON)%

		%([ INDICATE THAT THIS OPERATION IS SEQUENTIAL ])%

		SETFLAG ( RST [ RSTFLAGS ], FLGLASTSEQ )

		END %(OF IF THIS WAS A PUT SEQUENTAIL)%

	ELSE	%(THIS IS A RANDOM PUT...CLEAR THE SEQ BIT)%

		CLRFLAG ( RST [ RSTFLAGS ], FLGLASTSEQ );

	GOODRETURN
%FI
 END; %(OF SETPUT)%

END
ELUDOM