; ; B$ALOCATE ; ; B$ALOCATE -INTERNAL DATABASE ROUTINE FOR ALOCATING BLOCKS ; ; ROUTINE NAME: B$ALOCATE ; ; PURPOSE: Alocates blocks off of the free list or the end of ; a file for new keys in a database file. ; ; CALLABLE: From MACRO only ; ; PARAMETERS: ; R4 Pointer to root block and I/O buffers. ; R3 Returns pointing at the buffer. ; R2 Pointer to the level table stack. ; R1 Scratch used for storing block numbers. ; R0 Scratch used to store last legal address of block. ; ; ROUTINES USED: B$IOERROR, READVB and WRITEVB macros ; ; EXAMPLE: ; SCALL B$ALOCATE ; ON.ERROR THEN GOTO EROUTINE ; ; FEATURES: B$ALOCATE will conserve I/O operations when the ; block alocated was just dealocated recently. The ; de-alocated block will still be in core, and alo- ; cate will grab it without ever writing it into the ; disk version of the free list. ; ; AUTHOR: Mike Higgins ; ; SOURCE LANGUAGE: MACRO11 with SUPERMAC ; ; OBJECT MODULE NAME: B$ALOC ; ; LIBRARY: [60,100]MIKESLIB ; ; MAINTENANCE: See Mike Higgins ; ; ;REGESTER ASSIGNMENTS ROOT=R4 BUF=R3 LEVEL=R2 BLK=R1 LST=R0 ; .MCALL SUPER SUPER PROCEDURE B$ALOCATE LET BUF := RT.BUF(ROOT) ;GET ADDRESS OF IN CORE DATA BLOCK IF RT.FREE(ROOT) EQ #0 ;ARE THERE ANY BLOCKS IN THE FREE LIST? NEWB: LET RT.SIZE(ROOT) := RT.SIZE(ROOT) + #1 ;NO, INCREASE THE FILE SIZE LET BLK := RT.SIZE(ROOT) ;ALOCATE THE NEW BLOCK IF #FL.MOD SET.IN LV.FLG(LEVEL) ;IF THERE IS A BLOCK HERE ALREADY WRITEVB LV.PCB(LEVEL),BUF ;WRITE IT OUT FIRST!! END ELSE ;THERE IS SOMETHING IN THE FREE LIST LET BLK := RT.FRE(ROOT) ;GET POINTER TO FIRST BLOCK IN LIST IF BLK NE LV.PCB(LEVEL) ;IS THE CORE RESIDENT BLOCK THE TOP FREE BLOCK IF #FL.MOD SET.IN LV.FLG(LEVEL) ;NO, WRITE IT OUT WHEN NECC. WRITEVB LV.PCB(LEVEL),BUF END READVB BLK,BUF ;AND READ IN THE NEW BLOCK IF DB.BLT(BUF) NE #"FR ;MAKE SURE THIS IS A FREE BLOCK LET RT.FLG(ROOT) := . SET.BY #FL.COR ;FILE IS CORRUPT GOTO NEWB ;ALOCATE A NEW ONE INSTEAD END END LET RT.FRE(ROOT) := DB.PNB(BUF) ;LINK THE FREE LIST PAST THE BLOCK END LET LV.FLG(LEVEL) := . SET.BY #FL.MOD ;SET FLAGS FOR EVERYTHING YOU MODIFIED ;INCLUDING THE ROOT BLOCK LET RT.FLG(ROOT) := RT.FLG(ROOT) SET.BY #FL.MOD LET LV.PCB(LEVEL) := BLK ;POINT THE LEVEL TABLE TO THE NEW BLOCK ;CALCULATE THE ADDRESS OF THE ;OFSPRING BLOCK NUMBER IN THE ;PARENT KEY LET LST := LV.PCE-LV.SIZE(LEVEL) + LV.LEN-LV.SIZE(LEVEL) - #2 LET DB.PNB(BUF) := (LST) ;LINK THIS BLOCK TO ANY OLD DATA BLOCKS LET (LST) := BLK ;POINT THE PARENT KEY AT THE NEW BLOCK ;THAT MEANS YOU HAVE MODIFIED ;THE PARENT BLOCK, AND MUST MARK ;IT FOR WRITING OUT LET LV.FLG-LV.SIZE(LEVEL) := LV.FLG-LV.SIZE(LEVEL) SET.BY #FL.MOD ; ;INITALIZE THE NEW BLOCK ; LET DB.BLT(BUF) := #"DB ;FLAG THIS AS A DATA BLOCK LET BLK := LV.LEN(LEVEL) ;GET LENGTN OF A KEY ;COMPUTE LAST KEY ADDRESS IN BLOCK LET LST := BUF + #DB.LLA+2 - LV.LEN(LEVEL) WHILE BUF LE LST ;ZERO THE FIRST WORD IN EACH ELEMENT LET (BUF) := #0 ;LIKE THIS LET BUF := BUF + BLK ;INCRIMENT TO NEXT KEY END LET BUF := BUF - BLK ;DECRIMENT TO THE LAST KEY ZEROED ;CALCULATE THE LAST LEGAL KEY OFFSET LET LV.LLK(LEVEL) := BUF - RT.BUF(ROOT) LET RT.LLA(ROOT) := BUF ;STORE IT AWAY WHERE EVERYBODY CAN FIND IT ENDPROCEDURE B$ALOCATE .END