; ; ; WRTELE- WRITES A NON-UNIQUE KEY ; ; ; ; WRTELE ; ; WRTELE- WRITES A NON-UNIQUE KEY ; ; ROUTINE NAME: WRTELE ; ; PURPOSE: Writes a key in a database file without checking ; to assure that the key is unique. ; ; CALLABLE: From FORTAN only: ; CALL WRTELE(ROOT[,KEY][,VAL][,NUL][,ERR]) ; or ; ERR=WRTELE(ROOT[,KEY][,VAL]) ; ; PARAMETERS: ; ROOT The database root block and I/O buffers. ; KEY The scan section of the key to be written. ; VAL The data section of the key. ; NUL An ignored parameter that makes WRTELE calls com- ; patible with WRTKEY calls. ; ERR The error return parameter. Possible errors are: ; ERR=-100 Bad root block. ; ERR= -99 Write permission denied. ; ERR= 0 Could not write at this level. ; ERR= +n Successfull return. ; ; ROUTINES USED: B$ACTIVATE B$ALOCATE B$GETNEXT ; ; EXAMPLE: ; CALL WRTELE(ROOT,'TI') ; ERR=WRTELE(ROOT,,VAL) ; IF (WRTELE(ROOT,KEY,,,ERR) .LE. 0) GOTO 999 ; ; AUTHOR: Mike Higgins ; ; SOURCE LANGUAGE: MACRO11 with SUPERMAC ; ; OBJECT MODULE NAME: WRTELE ; ; LIBRARY: [60,100]DATABASE ; ; MAINTENANCE: See Mike Higgins ; ; ;REGESTER ASSIGNMENTS ROOT=R4 LEVEL=R2 BUF=R3 TEM=R1 TEM2=R0 ; PARAMETERS RT=2 KEY=4 VAL=6 NUL=10 ERR=12 .MCALL SUPER SUPER PROCEDURE WRTELE ;(ROOT[,KEY][,VAL][,NUL][,ERR]) LET ROOT := RT(R5) ;GET THE POINTER TO ROOT BLOCK IF DB.BLT(ROOT) NE #"RT ;IS THIS REALLY A ROOT? FORET #ER.NRB,ERR ;NO!!! RETURN END IF #FL.WRT OFF.IN RT.FLG(ROOT) ;DO YOU HAVE WRITE PERMISSION?? FORET #-99.,ERR ;NO?!! RETURN ;THEN YOU CANNOT WRITE END LET LEVEL := RT.PCL(ROOT) ;GET THE LEVEL TABLE SP IF #FL.ACT OFF.IN LV.FLG(LEVEL) ;IS THIS LEVEL ACTIVE YET? SCALL B$ACTIVATE ;NO, THEN ACTIVATE IT ON.ERROR THEN GOTO ALOCNEW ;IF YOU CANT ACTIVATE, THEN ALOCATE A NEW BLOCK LET BUF := RT.LLA(ROOT) ;GET POINTR TO LAST LEGAL KEY ADDRESS ELSE ;IF THIS LEVEL IS ACTIVE, GET THE ;PONTER TO THE NEXT KEY BACKWARDS LET BUF := LV.PCE(LEVEL) - LV.LEN(LEVEL) END REPEAT ;LOOP FOR ALL KEYS IF BUF LT RT.BUF(ROOT) ;HAVE I RUN OUT OF BLOCKS? SCALL B$GETNEXT ;YES, THEN GET SOME MORE ON.ERROR ;NO MORE, I'L HAVE TO MAKE ONE ALOCNEW: SCALL B$ALOCATE ;ALOCATE A NEW BLOCK ON.ERROR FORET #0,ERR ;WOOPS, I CAN'T ALOCATE ONE RETURN END LET LV.FLG(LEVEL) := . SET.BY #FL.ACT ;ACTIVATE THIS LEVEL GOTO XFRELE ;AND GO XFER THE KEY INTO IT END LET BUF := RT.LLA(ROOT) ;GET THE POINTER TO THE KEY IN NEXT BLOCK END IF (BUF) EQ #0 ;IS THIS KEY SPARE?? XFRELE: ;THEN YOU CAN PUT THE NEW ONE HERE LET LV.PCE(LEVEL) := BUF ;POINT THE ROOT BLOCK AT IT LET (BUF) := . + #1 ;INITALIZE THE FIRST WORD JUST IN CASE IF (R5) GE #KEY/2 ;IS THERE A KEY ARGUMENT? IF KEY(R5) NE #-1 ;YES, IS IT A NULL ARGUMENT? LET TEM := KEY(R5) ;NO, GET IT'S ADDRESS LET TEM2 := LV.SCN(LEVEL) ;GET THE LENGTH OF THE SCAN SECTION IF RESULT IS GT ;IS THERE A SCAN SECTION?? THRU TEM2 ;YES, LOOP FOR ALL BYTES IN IT IFB (TEM) EQ #0 ;IS IT PREMATURELY TERMINATED? LET (BUF)+ :B= #40 ;YES, SPACE FILL THE KEY ELSE IFB (TEM) EQ #'\ ;IS THIS A WILD CARD CHARACTER?? TSTB (TEM)+ ;THEN SKIP IT, AND LET (BUF)+ :B= #40 ;REPLACE WITH A BLANK ELSE LET (BUF)+ :B= (TEM)+ ;TRANSFER NORMAL CHARACTERS ACCROSS END END END END ELSE ;WHEN THERE IS NO KEY PARAMETER, SKIP ;TO THE DATA SECTION OF THE KEY LET BUF := BUF + LV.SCN(LEVEL) END IF (R5) GE #VAL/2 ;IS THERE A VAL PARAMETER? IF VAL(R5) NE #-1 ;YES, IS IT A NULL ARGUMENT? LET TEM := VAL(R5) ;NO, GET THE ARGUMENT ADDRESS ;CALCULATE THE LENGTH OF THE DATA SECTION LET TEM2 := LV.LEN(LEVEL) - LV.SCN(LEVEL) ;DATA SECTION IS 4 BYTES SHORTER ON ALL ;LEVELS ACCEPT THE BOTTOM ONE IF RT.LEV(ROOT) LT RT.NLV(ROOT) LET TEM2 := . - #4 ;THIS IS NOT THE BOTTOM END IF TEM2 GT #0 ;IS THERE A DATA SECTION? THRU TEM2 ;YES, LOOP FOR ALL BYTES IN IT LET (BUF)+ :B= (TEM)+ ;XFER THEM ACCROSS END END END END END ;THIS BLOCK HAS BEEN MODIFIED, SO MARK IT LET LV.FLG(LEVEL) := . SET.BY #FL.MOD IF RT.LEV(ROOT) LT RT.NLV(ROOT) ;IF THIS IS NOT THE BOTTOM LEVEL ;CALCULATE THE ADDRESS OF THE END OF KEY LET TEM := LV.PCE(LEVEL) + LV.LEN(LEVEL) LET -(TEM) := #0 ;ZERO THE POINTER TO OFSPRING LET -(TEM) := RT.AGE(ROOT) ;AND INITALIZE THE AGE OF THE KEY END FORET RT.LEV(ROOT),ERR ;RETURN SUCCESS RETURN END LET BUF := BUF - LV.LEN(LEVEL) ;DECRIMENT TO NEXT KEY WHEN LAST ONE ;WAS IN USE ALREADY END ;REPEAT LOOP ENDPROCEDURE WRTELE .END