DELETE864
(George Source)
Macros used: ACROSS, ADDSKIP, ALTLEN, BFCBX, BS, BXE, BXGE, BXL, BXU, CHAIN, DELETE, FILEAUTW, FILENUMB, FILEREAD, FILETRAN, FINDEXB, FREEBACK, FREECORE, FSHSKIP, GEOERR, GETBACK, JBC, JBS, KEYREC, LASTREKA, MAPBCH, MAPBDEL, MAPBIN, MAPBSE, MBS, MENDAREA, MHUNT, MHUNTW, NAME, OFF, PSTAC, SEGENTRY, SETNCORE, SFMAP, SFSTACK, SFUB, SUBCUBS, UP, VARIADNR, VARIADNW, VFREE
- DELETE864.txt
22FL #SEG DELETE [JUDY BIDGOOD. 22^= #OPT K0DELETE=K0ACCESS>K0FILESTORE>K0ALLGEO 23DW #LIS K0DELETE 23YG #OPT K6DELETE=K6ACCESS>K6FILESTORE>K6ALLGEO 24D6 8HDELETE 24XQ #OPT K6DELETEX=K6DELETE 25CB # 25X2 SEGENTRY K2DELETE,NZDELETE 26BL SEGENTRY K22DELETE,ZDELETE 26W= ZGEOERR 27*W GEOERR 1,DELETE! 27TG # 28*6 # THIS SEGMENT IMPLEMENTS THE ACCESS MACROS:- 28SQ # DELETE (ENTRY POINTS K2 AND K22) 29#B # IN CONJUCTION WITH THE FILESTORE RING SYSTEM 29S2 # 2=?L # 2=R= #SKI IFS<1$1 2?=W ( 2?QG SFULLB 2#=6 #HAL BSTB+FULLB,0 2#PQ SFMAP 2*9B #HAL FILE+FMAPP,0 2*P2 ) 2B8L # 2BN= # 2C7W FILETRAN [SUBROUTINES FOR SPECIAL FILESTORE 2CMG [B.S. TRANSFER ROUTINES 2CNN ...# THIS SUBROUTINE READS THE CURRENT BLOCK OF THE FILE INTO A 2CPW ...# BSTB-BREAD IN CORE. 2CR4 ...SFREAD 2CS= ... SBX 6 FX1 2CTD ... LDX 2 FX2 2CWL ... LDX 7 AWORK4(2) 2CXS ...#SKI JSKI33<1$1 2C^2 ... FILEREAD 7 2D28 ...#SKI JSKI33 2D3B ... FILEREAD 7,FAIL 2D4J ... ADX 6 FX1 2D5Q ... EXIT 6 0 2D76 PARAPOINT 2DLQ [THIS SUBROUTINE VALIDATES THE FILE LEVEL PARAMETER AND MAKES POSITIVE 2F6B [IF NECESSARY AND GIVES POINTERS:- 2FL2 [ X1-> TO TOP OF FSTACK BLOCK OF THIS FILE 2G5L [ X2-> FCB OF THIS FILE 2GK= [ X3-> TO RING ELEMENT OF FCA OF FILE OPEN AT LEVEL IN X6 2H4W LDX 6 ACOMMUNE7(2) [FILE DEPTH 2HJG SRA 6 15 [CONVERT 2J46 FILENUMB 4 [X4= NO FILES OPEN 2JHQ BPZ 6 POSLV [J IF DEPTH POSITIVE 2K3B ADX 6 4 [IF NEGATIVE ADD NUMBER OF FILES OPEN 2KH2 #SKI K6DELETEX 2L2L ( 2LG= BPZ 6 NOWP1 [ERROR IF STILL <0 2L^W NOTENUF 2MFG CALL 0 ZGEOERR [NOPENDEL 2M^6 ) 2NDQ POSLV 2NYB #SKI K6DELETEX 2PD2 BXGE 6 4,NOTENUF 2PXL NOWP1 2QC= STO 6 AWORK4(2) [STORE DEPTH 2QWW NOWP 2RBG LDX 2 FX2 2RW6 SFSTACK AWORK4(2),3,1 [GET X3 -> FCA 2S*Q [AND -> IN X1 TO TOP OF FSTACK BLOCK 2STB BFCBX 2,1 2T*2 EXIT 7 0 2TSL # 2W#= SFSTACK 2WRW LDX 3 FX2 2X?G SFSTACK AWORK4(3),3 [X3 -> FCA 2XR6 EXIT 7 0 2Y=Q # 2YQB SWITCHBLOCK 2^=2 # THIS ROUTINE DOES ALL THE NORMAL'CAREFUL'UPDATING. 2^PL # 329= LDN 0 4 32NW ANDX 0 FCOMM(2) [J IF'CAREFUL' BIT NOT SET IN FCB 338G BZE 0 (7) 33N6 SMO FX2 347Q STO 1 ACOMMUNE1 [STORE PTR TO USAGEB. 34MB LDX 0 FREADBLOCK(3) [CALCULATE APPROPRIATE BIT 3572 SBN 0 FBLKS-1 35LL MAPBCH 0,2 [WAS BIT SET 366= BNZ 0 YSET [J IF BIT SET 36KW SBX 7 FX1 375G STO 7 AWORK1(2) [PRESERVE LINK 37K6 PSTAC 1,3 [X1 -> FSTACK BLOCK 384Q BFCBX 2,1 [X2 -> FCB 38JB JBC NEWFULLB,2,BFALTB [DONT LOOK FOR FULLB,SET ONE UP,IF 3942 ['BLOCK NOS. ALTERED' BIT UNSET. 39HL CALL 7 SEEKFULLB [X1-> FULLB 3=3= BRN NEWFULLB [J IF NOT THERE 3=GW LDX 7 ALOGLEN(1) 3?2G ADN 7 1 3?G6 LDX 3 1 3?^Q ALTLEN 3,7 [ALTLEN BLOCK 3#FB CALL 6 SGETBACK [GET B.S. 3#^2 BRN SGOT 3*DL NEWFULLB 3*Y= SETNCORE 3,1,BSTB,FULLB 3BCW LDN 0 2 3BXG STO 0 A1(1) [R.H 3CC6 LDN 0 1000 3CWQ STO 0 A1+1(1) [RANDOM B.S.PREFIX 3DBB CALL 6 SGETBACK [GET A B.S.BLOCK ON RIGHT RESIDENCE 3DW2 NOFULLB 3F*L #SKI IFS 3FT= SFMAPP 2,2,ZGEOERR 3G#W #SKI IFS<1$1 3GSG ( 3H#6 LDX 2 FPTR(2) [JOVER FSTACK 3HRQ SLZ 3J?B LDX 2 FPTR(2) [NERT BLOCK 3JR2 LDX 0 ATYPE(2) 3K=L SMO FX1 3KQ= BXU 0 SFMAP,SLZ 3L9W ) 3LPG LDX 2 FPTR(2) 3M96 MHUNTW 1,BSTB,FULLB 3MNQ LDX 7 1 3N8B CHAIN 7,BPTR(2) [CHAIN FULLB IN 3NN2 LDX 1 7 3P7L PSTAC 2,3 3PM= BFCBX 2,2 [X2 -> FCB 3Q6W LDX 0 BSPRE(2) [RIGHT B.S.PREFIX 3QLG STO 0 A1+1(1) 3R66 LDX 1 FPTR(2) [->FSTACK 3RKQ SGOT 3S5B SMO FREADBLOCK(3) 3SK2 LDX 6 0(2) [OLD B.N. 3T4L SFUB 1,6,1,NOTFURBA [J IF FURB NOT AROUND 3TJ= YGOTFURB 3W3W STO 4 BACK1(1) [UPDATE B.S.HOME 3WHG STO 5 BACK2(1) 3X36 NAME 1,FILE,FUWB [SO IT GOES TO B.S. 3XGQ STO 1 4 [-> USAGE BLOCK 3Y2B SMO FREADBLOCK(3) [STORE IN FCB 3YG2 STO 5 0(2) 3Y^L CALL 7 SEEKFULLB [X1 FULLB 3^F= CALL 0 ZGEOERR [NO FULLB IN FILE CHAIN. 3^YW SMO A1(1) 42DG STO 6 A1(1) [STORE OLD B.N. 42Y6 LDN 0 1 43CQ ADS 0 A1(1) [UPDATE BLOCK COUNT 43XB LDX 0 FREADBLOCK(3) 44C2 SBN 0 FBLKS-1 [SET BIT FOR THIS BLOCK 44WL MAPBSE 0,2 [ [ SET BRT 45B= PSTAC 2,3 45TW BFCBX 2,2 [X2 -> FCB 46*G MBS 2,BFALTB,BFALTR [SET FILE AND BLOCK NOS. ALTERED BITS 46T6 LDX 1 4 [-> USAGE BLOCK 47#Q LDX 7 FX1 47SB SMO FX2 48#2 ADX 7 AWORK1 [X7 = EXIT 48RL EXIT 7 0 49?= YSET 49QW LDX 1 ACOMMUNE1(2) [X1 -> USAGE BLOCK 4==G PSTAC 2,3 4=Q6 BFCBX 2,2 [RESET X2 ->FCB 4=X# ... FSHSKIP B,TEXIT 4?4G ...( 4?9Q JBS TEXIT,2,BFALTB [J IF 'BLOCK NOS. ALTERED' BIT 4?PB CALL 0 ZGEOERR [ERROR IF NOT. 4?^8 ...) 4#92 TEXIT 4#NL EXIT 7 0 4*8= # 4*MW # 4B7G NOTFURBA 4BM6 VARIADNR 2 4C6Q ... CALL 6 SFREAD 4DKL CALL 6 SCHBSP [CHECK B.S.PREFIX 4F5= ADDSKIP I516A,ADLRD 4FJW MHUNTW 1,BSTB,BREAD [BUFFER BLOCK 4G4G NAME 1,FILE,FUWB 4GJ6 CHAIN 1,FPTR(2) [CHAIN AFTER FSTACK 4H3Q PSTAC 1,3 [X1 -> FSTACK 4HHB BFCBX 2,1 [X2 -> FCB 4J32 LDX 1 FPTR(1) [X1 -> USAGE BLOCK 4JGL SMO FREADBLOCK(3) 4K2= LDX 6 0(2) [OLD B.S.NUMBER 4KFW BRN YGOTFURB 4K^G # 4LF6 # TWO SUBROUTINES, 4LYQ # 1)SCHBSP:CHECKS B.N. IN X5 IS STILL OK,IF NOT,GETS RID OF IT & GETS 4MDB # A NEW ONE.B.S.P AT TIME OF 1ST GETBAX IN X4 . 4MY2 # 2)SGETBAC: GETS B.S, CHECKS B.S.P. STILL OK, IF NOT AS ABOVE 4NCL # 4NX= SCHBSP 4PBW SBX 6 FX1 4PWG CALL 7 NOWP [PT[S. 4QB6 BRN PREFCH 4QTQ SGETBACK 4R*B SGETBAC 4RT2 CALL 7 NOWP 4S#L SBX 6 FX1 4SS= SGBACK 4T?W LDX 4 BSPRE(2) [B.S.RPEFIX CURRENTLY 4TRG RGBACK 4W?6 GETBACK 4 [GET B.S. 4WQQ ADDSKIP I516A,BSGET 4X=B LDX 5 ACOMMUNE7(2) [PRESERVE BLOCK NUMBER. 4XQ2 CALL 7 NOWP [PTRS 4Y9L PREFCH 4YP= BXE 4 BSPRE(2),OKBSHO [J IF B.S.PREFIX UNCHANGED 4^8W LDX 7 4 [OLD B.S.P. 4^NG LDX 4 BSPRE(2) [NEXT ONE TO TRY 5286 FREEBACK 7,5 [FREE OLD BLOCK 52MQ ADDSKIP I516A,ADLFBL 537B BRN RGBACK 53M2 OKBSHO 546L ADX 6 FX1 54L= EXIT 6 0 555W # 55KG # 5656 # S/R TO SEEK FULLB. ON EXIT X2 -> FCB 56JQ # 574B SEEKFULLB 57J2 #SKI IFS 583L SFULLB 2,1,(7) 58H= #SKI IFS<1$1 592W ( 59GG LDX 1 FPTR(2) 5=26 SKFULLB 5=FQ LDX 1 FPTR(1) 5=^B BXE 1 CXFI,(7) 5?F2 LDX 0 ATYPE(1) 5?YL BXE 0 FILEPLUSFCB,(7) 5#D= SMO FX1 5#XW BXU 0 SFULLB,SKFULLB 5*CG LDX 0 A1+1(1) 5*X6 BXU 0 BSPRE(2),SKFULLB 5BBQ ) 5BWB EXIT 7 1 5CB2 # 5CTL # 5D*= SEEKBLOCK 5DSW [THIS SUBROUTINE WILL GIVE A POINTER IN X1 TO THE USAGE BLOCK OF B.S. 5F#G [BLOCK CURRENTLY BEING READ AND READ IT DOWN FROM B.S. IF NECESSARY 5FS6 [IT ALSO CHECKS THAT THE FILE HAS BEEN READ 5G?Q SBX 7 FX1 5GRB SMO FX2 5H?2 STO 7 AWORK1 [STORE LINK. 5HQL LDX 4 FREADBLOCK(3) 5J== #SKI K6DELETEX 5JPW BNG 4 OFF [ERROR IF NOT READ ANY OF FILE 5K9G LDX 5 FREADWORD(3) 5KP6 BPZ 5 SAMBL [J IF -> NOT TO END OF PREVIOUS BLOCK 5L8Q #SKI K6DELETEX 5LNB ( 5M82 LDN 0 FBLKS+1 [CHECK NOT MOVING BACK BEYOND START 5MML BXGE 4 0,NOTSTART [OF FILE 5N7= OFF 5NLW CALL 0 ZGEOERR [BEG FILE 5P6G ) 5PL6 NOTSTART 5Q5Q #SKI K6DELETE 5QKB ( 5R52 LDX 0 FBLMOD(2) 5RJL ADN 0 A1-1 5S4= SBX 0 FREADBLOCK(3) 5SHW BNG 0 NOTZEN 5T3G LDX 0 FREADWORD(3) 5TH6 BPZ 0 ZEN 5W2Q NOTZEN 5WGB ) 5X22 SMO 4 5XFL LDX 4 0(2) [PIC- UP BLOCK NUMBER 5X^= SFUB 1,4,1,NOLDFUB [1 J IF USAGE BLOCK NOT IN CASE 5YDW YFRENULB 5YYG CALL 4 VFREE [DEAL WITH SPENT BLOCK 5^D6 NOLFU 5^XQ LDX 4 FREADBLOCK(3) [X4 CORRUPTED BY CALL 62CB SAMBL1 62X2 SBN 4 1 [MOVE BLOCK -> BACK BY ONE 63BL STO 4 FREADBLOCK(3) 63W= SAMBL 64*W SMO 4 64TG LDX 4 0(2) [PICK UP BLOCK NO OF REQUIRED BLOCK 65*6 SFUB 1,4,1,NOFUB [FIND ITS USAGE BLOCK IF IN CORE 65SQ YFUB 66#B BPZ 5 NONUFUB [J IF NO NEED TO RESET READ POINTER 66S2 LDN 4 A1 67?L SBLMOD1 67R= SBLMD 68=W SMO 4 68QG LDX 0 FRH(1) 69=6 BZE 0 YZE [JIF END OF BLOCK 69PQ BPZ 0 YPOS [J IF NOT DUMMY 6=9B LDEX 0 0 6=P2 ADX 4 0 6?8L BRN SBLMOD1 6?N= YPOS LDX 5 4 6#7W ADX 4 0 6#MG BRN SBLMD 6*76 YZE BNG 5 YFRENULB 6*LQ STO 5 FREADWORD(3) 6B6B NONUFUB 6BL2 SMO FX2 6C5L LDX 7 AWORK1 [LINK 6CK= ADX 7 FX1 6D4W EXIT 7 0 6DJG NOLDFUB 6F46 CALL 4 VEXITA 6FHQ BRN NOLFU 6G3B NOFUB 6GH2 VARIADNR 2 6H2L ADDSKIP I516A,ADLRD 6HG= ... CALL 6 SFREAD 6J^6 MHUNT 1,BSTB,BREAD 6KDQ NAME 1,FILE,FURB [RENAME AS A USAGE BLOCK 6KYB CALL 7 SFSTACK [X3->FCA 6LD2 PSTAC 2,3 6LXL LDX 4 2 [X4->FSTACK 6MC= CHAIN 1,4 6MWW SMO 4 6NBG LDX 1 FPTR [X1-> TO USAGE BLOCK AGAIN 6NW6 SMO 4 6P*Q LDX 2 BPTR [X2-> TO FCB AGAIN 6PTB LDX 0 BSPRE(2) [SWAP ROUND B.S. 6Q*2 STO 0 BACK1(1) [HOME OF BLOCK 6QSL SMO FREADBLOCK(3) [IN CASE IT HAS 6R#= LDX 0 0(2) [CHANGED 6RRW STO 0 BACK2(1) 6S?G BRN YFUB 6SR6 # 6T=Q # 6TQB PICKBLOCK 6W=2 # THIS S/R SEARCHES FOR & SETS X1 -> THE USAGE BLOCK BEFROE THE 6WPL # ONE SPECIFIED 6X9= SBX 7 FX1 6XNW SMO FX2 6Y8G STO 7 AWORK1 [STORE LINK. 6YN6 NGN 5 1 [KID THE ROUTINE WE WANT PREVIOUS 6^7Q [BLOCK & LAST RECORD IN IT 6^MB BRN SAMBL1 [CNOTINUE AS IN SEEKBLOCK S/R 7272 # 72LL # THIS ROUTINE DEALS WITH BLOCK POINTED TO BY X1 736= # CALLED BY X4,ON EXIT X3-> FCA,X2->FCB,X1-> FSTACK 73KW VFREE 745G JBS VEXITA,2,BFCORE [J IF 'LEAVE BLOCKS IN CORE' BIT SET. 74K6 LDX 0 ATYPE(1) 754Q BXE 0 FFSFUWB,UWRITE [J IF WRITE BLOCK 75JB FREECORE 1 [FREE 7642 ADDSKIP I516A,ADLFR 76HL BRN VEXITA 773= UWRITE 77GW VARIADNW 2 782G SBX 4 FX1 78G6 CHAIN 1,FX2 [CHAIN NEXT TO ACT BLK. 78^Q LDX 2 FX2 79FB LDX 6 AWORK4(2) 79^2 FILEAUTW 6,FAIL+FREE [READ DOWN BLOCK 7=DL ADDSKIP I516A,ADLWR 7=Y= ADX 4 FX1 7?CW VFREA 7?XG CALL 7 SFSTACK [X3->FCA 7#C6 VEXITA 7#WQ PSTAC 1,3 7*BB BFCBX 2,1 7*W2 EXIT 4 0 7B*L MOVEBLOK 7BT= # THIS S/R RESHUFFLES THE BLOCKS IN THE FCB BLOCKLIST 7C#W # X2-> FCB X3 -> FCA 7CSG LDN 0 1 7D#6 SBS 0 FBLMOD(2) [REDUCE FBLMOD 7DRQ STO 1 5 [PRESERVE BLOCK NO. 7F?B STO 2 4 [PRESERVE FCB POINTER 7FR2 SUBCUBS 3,0,JOB [DECREMENT NO. OF BLOCKS USED. 7G=L LDX 2 4 7GQ= LDX 1 5 7H9W LDX 0 FUSEBL(2) 7HPG ADN 0 A1-1 [IF FREADBLOCK POINTS TO THE LAST 7J96 SBX 0 FREADBLOCK(3) [BLOCK NOS.ON THE LIST,WE HAVE 7JNQ BZE 0 MOVENOBLOK [NO BLOCK NOS.TO MOVE,SO JUMP 7K8B LDX 5 FREADBLOCK(3) 7KN2 ADX 5 2 [BLOCK NO. TO BE OVERWRITTEN. 7L7L LDX 4 5 7LM= ADN 4 1 7M6W SMO 0 [MOVE BLOCK NUMBERS UP 7MLG MOVE 4 0 [FREADBLOCK NOW POINTS TO BLOCK NO. 7N66 MOVENOBLOK 7NKQ LDCT 0 #400 7P5B ORS 0 FREADWORD(3) 7PK2 ORS 0 CMOD(2) [SET CMOD TO POINT TO END OF LAST BL. 7Q4L QCARE 7QJ= JBC (7),2,BFCARE [J IF 'CAREFUL' BIT NOT SET IN FCB. 7R3W LDX 0 FREADBLOCK(3) [CALCULTAE BIT NO 7RHG SBN 0 FBLKS-1 7S36 SMO FX2 [STORE X1 7SGQ STO 1 AWORK1 7T2B MAPBDEL 0,2 7TG2 LDX 1 AWORK1(2) [PICK IT UP AGAIN 7T^L PSTAC 2,3 7WF= BFCBX 2,2 7WYW EXIT 7 0 7XDG # 7XY6 # 7YCQ # 7YXB [ 7^C2 NZDELETE [DELETE ENTRY,N/Z DEPTH 7^WL [ 82B= CALL 7 PARAPOINT [X6=DEPTH,X3->FCA,X2->FCB,X1->FSTACK. 82TW BRN MERGEDEL 83*G [ 83T6 ZDELETE [DELETE ENTRY,ZERO DEPTH 84#Q [ 84SB LDN 6 0 [DEPTH 85#2 CALL 7 NOWP1 [X3 ->FCA X2 ->FCB,X1->FSTACK 85RL MERGEDEL 86?= ADDSKIP I516A,IDELT 86QW BS 3,BADEL [SET MARKER IN FGENERAL1 TO INDICATE 87=G [DELETE HAS BEEN DONE ON FILE. 87Q6 #SKI K6DELETEX 889Q ( 88PB JBS MODEL,3,BAMGEN [CHECK FILE OPEN IN GENERAL MODE 8992 CALL 0 ZGEOERR [ERROR IF NOT 89NL ) 8=8= MODEL 8=MW LDX 0 FREADBLOCK(3) 8?7G SBN 0 A1 [UNUSED BLOCK NUMBER ? 8?M6 SBX 0 FBLMOD(2) 8#6Q BNZ 0 NOTDELF [J IF NOT 8#LB #SKI K6READFILE 8*62 ( 8*KL LDX 0 FREADWORD(3) 8B5= BPZ 0 ZEN [ERROR IF "READ E.O.F" 8BJW ) 8C4G LDX 4 FREADBLOCK(3) [SET X4 8CJ6 CALL 7 PICKBLOCK [FIND PREVIOUS BLOCK 8D3Q BRN NOSKBLK 8DHB NOTDELF 8F32 CALL 7 SEEKBLOCK [FIND THE USAGE BLOCK 8FGL NOSKBLK 8G2= SMO 5 [PICK UP RECORD HEADER OF RECORD 8GFW LDEX 4 0(1) [TO BE DELETED 8G^G BNZ 4 MAYDEL [MAKE SURE NOT POINTING AT E.O.F 8HF6 #SKI K6DELETE 8HYQ ( 8JDB LDX 0 FREADBLOCK(3) 8JY2 SBN 0 A1-1 8KCL BXL 0 FBLMOD(2),MAYDEL1 8KX= ZEN 8LBW CALL 0 ZGEOERR [ENDFILE 8LWG ) 8MB6 MAYDEL1 8MKY ... CALL 4 VFREE 8MTQ LDN 0 1 8N*B ADS 0 FREADBLOCK(3) 8NT2 LDN 0 A1 8P#L STO 0 FREADWORD(3) 8Q?W BRN NOTDELF 8QRG MAYDEL 8R?6 STO 1 GEN6 [STORE USAGE BLK PTR 8RQQ ADX 1 FREADWORD(3) [X1-> REC. TO BE DELETED 8S=B SMO FX2 8SQ2 NGS 1 AWORK2 [INITIALIZE KEY INDICATOR. 8T9L KEYREC 2,,1,NOINDEX,7 [X7 CONTAINS KEY,IF ANY. 8TP= SMO FX2 8W8W STOZ AWORK2 [INDICATES RECORD IS KEYED. 8WNG SMO FX2 8X86 STO 7 AWORK3 8XMQ NOINDEX 8Y7B LDX 1 GEN6 8YM2 CALL 7 SWITCHBLOCK [DO 'CAREFUL' UPDATING. 8^6L LDX 5 FREADWORD(3) 8^L= YDUM65 925W SMO 5 [PICK UP R.H.OF DELETEE 92KG LDX 4 FRH(1) [NEXT I.H. 9356 BPZ 4 NDUM65 [J IF NOT DUMMX 93JQ LDEX 4 4 944B #SKI K6DELETE 94J2 ( 953L BNZ 4 OKRH 95H= ODDREC [RECORD? SOMETHING ODD ABOUT THE 962W CALL 0 ZGEOERR [READ POINTERS. 96GG OKRH 9726 ) 97FQ ADX 5 4 97^B ADS 4 FREADWORD(3) 98F2 BRN YDUM65 98YL NDUM65 99D= BZE 4 MAYDEL1 [JIF POINTING TO ZERO REC 99XW ADX 5 4 9=CG SMO 5 9=X6 LDX 0 FRH(1) 9?BQ BPZ 0 NDUM91 9?WB LDEX 0 0 9#B2 #SKI K6DELETE 9#TL BZE 0 ODDREC 9**= BRN NOTLAST [DELETEE NOT LAST REC IN BLOCK 9*SW NDUM91 9B#G [*NEXT LINE OF CODE IS ONLY SUFFICIENT ON THE ASSUMPTION THAT THERE IS 9BS6 [ ALWAYS A ZERO RECORD AT THE END OF THE BLOCK* 9C?Q BZE 0 ZEROREC 9CRB NOTLAST 9D?2 LASTREKA 1,5 [X5 RELATIVE PTR TO ZERO RECORD 9DQL [X1 UNCORRUPT 9F== SMO FX2 [STORE AMOUNT USED IN BLOCK FOR END 9FPW STO 5 AWORK1 [WRERE WE CALCULATE IF WE NEED TO 9G9G [COMPINSS THE FILE 9GP6 LDX 7 FREADWORD(3) 9H8Q ADX 7 1 [X7-> TO RECORD TO BE DELETED 9HNB LDX 6 7 9J82 ADX 6 4 [ONE TO BE DELETED 9JML SBX 5 6 9K7= ADX 5 1 [X5 IS NOW NO OF WORDS TO BE MOVED UP 9KLW SMO 5 [MOVE UP THE RECORDS OVER THE DELETED 9L6G MOVE 6 1 [ONE +1 WORD TO GIVE ZERO RECORD 9LL6 [HEADER AT THE END OF THE RECORDS 9M5Q SBX 7 1 9MKB SUPDATE 9N52 NAME 1,FILE,FUWB [MAKE SURE USAGE BLOCK IS FUWB 9NJL LDX 0 FBLMOD(2) 9P4= ADN 0 A1-1 9PHW BXU 0 FREADBLOCK(3),NLAST [J IF NOT LAST BLOCK 9Q3G LDX 0 CMOD(2) [HAS BLOCK BEEN APPENDED TO 9QH6 BNG 0 NLAST 9R2Q SBS 4 CMOD(2) [UPDATE APPEND MODIFIER 9RGB NLAST 9S22 BS 2,BFALTR [SET 'FILE ALTERED' BIT. 9SFL RESETRP 9S^= LDN 2 A1 [NOW WANT TO RESET READWORD POINTER 9TDW BXU 2 7,PAGA [J IF NOT -> TO TOP RECORD IN BLOCK 9TYG LDCT 0 #400 9WD6 ORS 0 FREADWORD(3) [SET NEGATIVE IF -> TO TOP RECORD 9WXQ UP 9XCB SMO FX2 9XX2 LDX 0 AWORK2 [RECORD KEYED? 9YBL BNG 0 NOTINDEX [J IF NOT 9YW= SMO FX2 9^*W LDX 7 AWORK3 [PICK UP KEY 9^TG SMO FX2 =2*6 LDX 4 AWORK4 [X4 CONTAINS FILE DEPTH =2SQ FINDEXB 4,2 [X2->FINDEXF BLOCK =3#B ADX 2 FREADBLOCK(3) =3S2 SBN 2 FBLKS-INDEXREC [X2->BLOCK KEY FOR CURRENT =4?L LDX 0 0(2) [BLOCK OF FILE =4R= BXL 7 0,NOTINDEX [J IF CURRENT REC KEY IS NOT =5=W PSTAC 2,3 [EQUAL TO BLOCK KEY. =5QG BFCBX 2,2 =6=6 BS 2,BFINDEXALT [SET 'INDEX ALTERED' BIT. =6PQ SMO FX2 =79B STO 4 AWORK2 [STORE FILE DEPTH =7P2 NAME 1,FI,FUTILITY [RENAME USAGE BLOCK FOR INDEX =88L ACROSS INDEX,5 [CALCULATE NEW BLOCK KEY. =8N= NOTINDEX =97W UP1 =9MG UP ==76 PAGA LDX 0 2 ==LQ SMO 2 [GET NEXT RECORD HEADER IN X2 AND IF =?6B LDEX 4 FRH(1) [IT IS THE SAME AS X7, =?L2 ADX 2 4 [WHICH IS POINTER TO =#5L BXU 2 7,PAGA [LAST RECORD PUT -> TO IMMEDIATELY =#K= STO 0 FREADWORD(3) [PRECEEDING RECORD IN FREADWORD =*4W SMO 0 =*JG LDX 4 FRH(1) [J IF NOT DUMMY TO EXIT =B46 BPZ 4 UP [O/W GO BACK ROUNDLOOP =BHQ LDX 7 0 [RESET X7 =C3B BRN RESETRP =CH2 # DELETEE IS LAST RECORD IN BLOCK. =D2L ZEROREC =DG= LDX 5 FREADWORD(3) =D^W SMO FX2 [STORE PACKING IN THIS KLFLK =FFG STO 5 AWORK1 [IN AWORK1 =F^6 LDN 0 A1 =GDQ BXE 5 0,SFREE [J IF BLOCK NOW EMPTY =GYB SMO 5 =HD2 STOZ 0(1) =HXL NLREC SMO 0 =JC= LDEX 4 0(1) =JWW ADX 0 4 =KBG BXU 0 5,NLREC =KW6 LDX 7 5 =L*Q BRN SUPDATE =LTB SFREE =M*2 FREECORE 1 [FREE EMPTY USAGE BLOCK =MSL PSTAC 2,3 =N#= BFCBX 2,2 =NRW MBS 2,BFALTR,BFALTB [SET 'FILE AND BLOCK NOS. ALTERED' BI =P?G SMO FREADBLOCK(3) =PR6 LDX 1 0(2) [X1 = BLOCK NUMBER NOW FREE. =Q=Q LDX 0 FBLMOD(2) =^5G NOSPARE =^K6 CALL 7 MOVEBLOK [RESHUFFLE BL.NOS ?24Q NOSPARE1 ?2JB SMO FUSEBL(2) ?342 STO 1 A1-1(2) ?3HL JBC UP2,2,BFCARE [J IF NOT A 'CAREFUL' FILE. ?43= ... LDX 0 FUSEBL(2) ?4GW ... SBN 0 FBLKS-A1-1+1 [NUMBER NEEDED IS THAT FROM BEFORE FU ?52G SMO FX2 ?5G6 LDX 6 AWORK4 [FILE DEPTH ?5^Q MAPBIN 0,6 [APPEND BIT (ENSERT AT END ?6FB UP2 ?6^2 CALL 7 NOWP ?7DL LDN 0 #77 [FILE INDEXED? ?7Y= ANDX 0 FINFC(2) ?8CW BZE 0 UP1 [J IF NOT. ?8XG LDX 2 FX2 ?9C6 LDX 0 AWORK4(2) [FILE DEPTH. ?9WQ STO 0 AWORK2(2) ?=BB ACROSS INDEX,7 [REMOVE KEY IN INDEX BLOCK ?=W2 # ??*L MENDAREA 30,K99DELETE ??T= #END ^^^^ ...04441302000200000000