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