{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: DELETE864)}}
====== DELETE864 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ADDSKIP|ADDSKIP]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BFCBX|BFCBX]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:DELETE|DELETE]], [[george:macro:FILEAUTW|FILEAUTW]], [[george:macro:FILENUMB|FILENUMB]], [[george:macro:FILEREAD|FILEREAD]], [[george:macro:FILETRAN|FILETRAN]], [[george:macro:FINDEXB|FINDEXB]], [[george:macro:FREEBACK|FREEBACK]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHSKIP|FSHSKIP]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETBACK|GETBACK]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:KEYREC|KEYREC]], [[george:macro:LASTREKA|LASTREKA]], [[george:macro:MAPBCH|MAPBCH]], [[george:macro:MAPBDEL|MAPBDEL]], [[george:macro:MAPBIN|MAPBIN]], [[george:macro:MAPBSE|MAPBSE]], [[george:macro:MBS|MBS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:OFF|OFF]], [[george:macro:PSTAC|PSTAC]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SFMAP|SFMAP]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:SFUB|SFUB]], [[george:macro:SUBCUBS|SUBCUBS]], [[george:macro:UP|UP]], [[george:macro:VARIADNR|VARIADNR]], [[george:macro:VARIADNW|VARIADNW]], [[george:macro:VFREE|VFREE]]
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