(George Source)
Macros used: ACROSS, ADDSKIP, ALTLEN, BFCBX, BLOCK, BRINDEX, BS, BXE, BXGE, BXL, BXU, CHAIN, FILECOUNT, FREEBACK, GEOERR, GETBACK, JBC, KEYREC, MAPBCH, MAPBSE, MBS, MENDAREA, MHUNTW, NAME, PSTAC, SEGENTRY, SETNCORE, SETREP, SFSTACK, STEP, STEPAGAIN, TESTREP, TOPFCA2, TRACE, UP
22FL #SEG INSERT6 [ JUDY BIDGOOD 22^= #OPT K0INSERT=K0ACCESS>K0FILESTORE>K0ALLGEO 23DW #OPT K6INSERT=K6ACCESS>K6FILESTORE>K6ALLGEO 23YG #LIS K0INSERT 24D6 8HINSERT 24XQ [ 25CB SEGENTRY K1INSERT,XINSERT [INSERT 25X2 SEGENTRY K2INSERT,XREPLACE [REPLACE 26BL SEGENTRY K11INSERT,ZINSERT [INSERT - ZERO DEPTH 26W= SEGENTRY K12INSERT,ZREPLACE [REPLACE - ZERO DEPTH 27*W SEGENTRY K10INSERT,ZCOMPRESS [SPECIAL INSERT FOR COMPRESS. 27TG [ 28*6 # THIS SEGMENT IMPLEMENTS THE INSERT & REPLACE SERIAL ACCESS MACROS 28SQ # 29#B # THIS SEGMENT DEALS WITH THE FEW EASY CASES. 29S2 # 2=?L # 2=R= # USES OF AWORK WORDS 2?=W # 2?QG # AWORK1 : B0 : REPLACE 2#=6 # B1 : REPLACING LAST RECORD IN BLOCK 2#PQ # B2 : CAREFUL FILE 2*9B # B3 : OVERFLOW FORWARD BIT 2*P2 # B4 : "RECORD IN NEXT BLOCK"(R.I.N.B.) BIT. 2B8L # B5 : AN EMPTY BLOCK HAS BEEN SET UP 2BN= # B6 : AN EMPTY BLOCK AT E.O.F.HAS BEEN SET UP. 2C7W # B7 : INSERT3 BLOCK A RE-NAMED FUWB. 2CG? ...# B8 : SPECIAL INSERT FOR COMPRESSING FILES. 2CSN ...# B9 : TWO NEW BLOCKS WILL BE NEEDED TO COMPLETE INSERT 2D76 # 2DLQ # B15-B23: SIZE EXTRA REQUIRED 2F6B # AWORK2 : FILE DEPTH 2FL2 # AWORK3 : TOP 9 BITS = SIZE OF RECORD 2G5L # : BOTTOM 10 BITS=A1+AMOUNT USED IN INSERT1 BLOCK. 2GK= # AWORK4 : WORKING SPACE WORD 2H4W # 2HJG # 2J46 # ACOMMUNE WORDS 2JHQ # ACOM5 : -> FCA BETWEEN COORS 2K3B # 2KH2 # 2L2L # 2LG= # 2L^W # 2MFG # ERRORS 2M^6 ZGEOER1 2NDQ GEOERR 1,NOINSERT [NO FILE/FWB FOR INSERT 2NYB ZGEOER2 2PD2 GEOERR 1,RECORD? [RECORD BEING OPERATED ON WRONG. 2PXL ZGEOER3 2QC= GEOERR 1,INSRDEEP [NO FILE OPEN AT REQUISITE DEPTH 2QWW ZGEOER4 2RBG GEOERR 1,NOPENINS [NOT OPEN IN GENERAL MODE 2RW6 ZGEOER5 2S*Q GEOERR 1,FULLBGON [FULLB GONE.OUGHT TO BE PRESENT 2STB ZGEOER6 2T*2 GEOERR 1,MOVEZERO [UNEXPECTED ZERO MOVE IN INSERT 2TSL ZGEOER7 2W#= GEOERR 1,STO ZERO [MOVE OR LESS AS ABOVE 2WRW ZGEOER8 2X?G GEOERR 1,WILL GO! [INSERT HAS MISCALCULATED 2XR6 ZGEOER9 2Y=Q GEOERR 1,NO BLOCK [ERROR IN SFINDFURB S/R. 2YQB ZGEOER10 2^=2 GEOERR 1,BLOKRONG [USAGE BLOCK IN WRONG PART OF CORE 2^PL ZGEOER11 329= GEOERR 1,ENDBLOCK [INSERT REACHED E.O.B. UNEXPECTEDLY. 32NW ZGEOER13 338G GEOERR 1,INDEX? [SOMETHING WRONG WITH INDEXING 33N6 # 347Q SFULLB 34MB #HAL BSTB+FULLB,0 3572 THREE +3 35LL # 366= # 36KW # SUBROUTINES 375G # NONZERO DEPTH ENTRY 37K6 ZDEEP 384Q FILECOUNT 0 [X0=NO.FILES OPEN 38JB LDX 1 ACOMMUNE7(2) 3942 SRA 1 15 [CONVERT & STORE 39HL STO 1 AWORK2(2) [DEPTH 3=3= BNG 1 ZD1 [CHECK 3=GW SBX 1 0 [DEPTH 3?2G BPZ 1 ZGEOER3 3?G6 BRN ZD3 [OK 3?^Q ZD1 ADX 0 1 3#FB BNG 0 ZGEOER3 3#^2 ZD3 3*DL SFSTACK AWORK2(2),1 [X1 -> FCA 3*Y= BRN ZD4 3BCW # ZERO DEPTH ENTRY 3BXG ZTOP 3CC6 STOZ AWORK2(2) [ZERO DEPTH 3CWQ TOPFCA2 1 3DBB ZD4 3DW2 JBC ZGEOER4,1,BAMGEN [ERROR IF NOT OPEN IN GENERAL MODE 3F*L STOZ AWORK1(2) [MARKER WORD 3FT= PSTAC 1,1 3G#W BFCBX 1,1 3GSG JBC (7),1,BFCARE [JIF NOT CAREFUL FILE 3H#6 LDCT 0 #100 [IF IT SET,SET BIT 3HRQ ORS 0 AWORK1(2) 3J?B EXIT 7 0 3JR2 # MINI-SUBROUTINES 3K=L # 3KQ= # 3L9W SFCB3 [SET X3-> FCB 3LPG SMO FX2 3M96 LDX 0 AWORK2 3MNQ SFSTACK 0,3 [X3 -> FCA 3N8B SMO FX2 3NN2 STO 3 ACOMMUNE5 [STORE 3P7L PSTAC 3,3 3PM= BFCBX 3,3 [X3 -> FCB 3Q6W EXIT 6 0 3QLG # 3R66 # 3RKQ SENDBLOCK 3S5B #SKI K6INSERT>699-699 3SK2 TRACE 3,SENDBLOK 3T4L LDX 1 3 [X3 &X1 -> NEXT RECORD 3TJ= SEBLP 3W3W LDEX 0 FRH(1) [NEXT R.H 3WHG ADS 0 1 [ADD INTO PTR 3X36 BNZ 0 SEBLP [J BACK IF NON ZERO 3XGQ #SKI K6INSERT>699-699 3Y2B TRACE 1,SENDIS 3YG2 EXIT 7 0 [EXIT 3Y^L # 3^F= SFURB 3^YW SMO FX2 42DG LDX 0 AWORK2 [SET X2 - > FSTACK 42Y6 SFSTACK 0,2 [X2 -> FCA 43CQ SMO FX2 43XB STO 2 ACOMMUNE5 [STORE 44C2 SFFURB 44WL PSTAC 2,2 [X2 -> FSTACK 45B= BRN SFFULP 45TW SFINDFURB 46*G # CALLED BY X1.THE WORD AFTER THE CALL CONTAINS THE TYPE/SUBTYPE 46T6 # WANTED.X3 ->FCB,X2 WILL POINT ON EXIT TO THE BLOCK REQUIRED. 47#Q LDX 2 FPTR(3) [J OVER FSTACK BLOCK 47SB SFFULP 48#2 LDX 2 FPTR(2) [NEXT BLOCK 48RL LDX 0 ATYPE(2) 49?= #SKI K6INSERT 49QW BXE 0 FILEPLUSFCB,ZGEOER9 [ERROR IF NOT FOUND 4==G BXU 0 0(1),SFFULP [J IF WRONG TYPE 4=Q6 EXIT 1 1 [EXIT ROUND TYPE-WORD 4?9Q # 4?PB SFLPB 4#92 LDX 2 FPTR(3) [->FSTACK 4#NL BRN SFLP 4*8= # 4*MW SFINDFULLB [SET X3 ->FCB,X2-> APPROPRIATE FULLB 4B7G # CALLED BY X6,OVERWRITES X2,WHICH POINTS TO AN APPROPRIATE FULLB 4BM6 # FOR THIS FILE ON SUCCESSFUL EXIT (+1) 4C6Q # EXIT +0 => NO FULLB 4CLB # X3 POINTS TO FCB. 4D62 SMO FX2 4DKL LDX 0 AWORK2 4F5= SFSTACK 0,2,2 [FIND X2 -> FSTACK 4FJW BFCBX 3,2 [X3 -> FCB 4G4G SFLP 4GJ6 LDX 2 FPTR(2) [NEXT BLOCK 4H3Q BXE 2 CXFI,(6) [EXIT IF E.O.CHAIN. 4HHB LDX 0 ATYPE(2) [TYPE 4J32 BXE 0 FILEPLUSFCB,(6) [EXIT FCB, SEARCH UNSUCCESSFUL 4JGL SMO FX1 4K2= BXU 0 SFULLB,SFLP [J IF NOT BSTB/FULLB 4KFW LDX 0 A1+1(2) 4K^G BXU 0 BSPRE(3),SFLP [J IF WRONG B.S.PREFIX. 4LF6 EXIT 6 1 4LYQ # 4MDB SFCA2 4MY2 SMO FX2 4NCL LDX 0 AWORK2 [DEPTH 4NX= SFSTACK 0,2 [X2 -> FCA 4PBW SMO FX2 4PWG STO 2 ACOMMUNE5 4QB6 EXIT 6 0 4QTQ # 4R*B # 4RT2 SCAREFULA 4S#L # THIS ROUTINE DOES ALL THE CAREFUL UPDATING FOR 1 BLOCK HAVING 4SS= # BEEN CHANGED. IF NECESSARY A BSTR/FULLB IS SET UP,OR ALTLEN'ED, 4T?W # AND THE BLOCK NO. IS SWAPPED OVER 4TRG # 4W?6 # OVERWRITES X1,2,3,6, CALLED BY X7 4WQQ # X4 THROUGHOUT INDICATES WHICH BLOCK NUMBER TO CHANGE (A FREADBLOCK 4X=B # TYPE PTR REL. TO AD OF THE FCB); 4XQ2 # ON EXIT X2 -> THE USAGE BLOCK; THIS IS ASSUMED TO BE A 4Y9L # FI/INSERT4 BLOCK 4YP= # 4^8W #SKI K6INSERT>199-199 4^NG TRACE 4,CAREFUL 5286 JBC STEND,3,BFCARE [EXIT IF NOT CAREFUL 52MQ LDX 0 4 [BLOCK WE'RE INTERESTED IN 537B SBN 0 FBLKS-1 [DATUMISE 53M2 MAPBCH 0,3 [CHECK IF BIT SET 546L BNZ 0 STEND [EXIT IF IT IS 54L= #SKI K6INSERT>399-399 555W TRACE FUSEBL(3),NO BIT 55KG SBX 7 FX1 [DATUMISE LINK 5656 JBC NEWFULLB,3,BFALTR [IF FILE NOT ALTERED,SET UP A FULLB 56JQ CALL 6 SFLPB [X2->FULLB 574B BRN NEWFULLB [J IF FULLB NOT PRESENT 57J2 LDX 6 ALOGLEN(2) [NOW ALTLEN FULLB 583L ADN 6 1 58H= LDX 3 2 592W ALTLEN 3,6 [BY ONE WORD 59GG CALL 6 SFINDFULLB [X2-> FULLB,X3->FCB 5=26 CALL 0 ZGEOER5 [ERROR IF UNSUCCESSFUL,X0 TELLS US 5=FQ BRN SFULONG [WHENCE WE CAME FOR GEOERR. 5=^B NEWFULLB 5?F2 #SKI K6INSERT>399-399 5?YL TRACE COMM(3),NEWFULLB 5#D= SETNCORE 3,1,BSTB,FULLB [SET UP FUUB,X1 -> IF 5#XW CALL 6 SFCB3 [X3 ->FCB 5*CG LDX 2 3 [X1 -> FCB 5*X6 XLP 5BBQ LDX 2 FPTR(2) [NEXT BLOCK IN FILE CHAIN. 5BWB BXE 2 CXFI,SCHAIN [J IF END OF FILE CHAIN 5CB2 LDX 0 ATYPE(2) 5CTL BXE 0 FILEPLUSFCB,SCHAIN [J IF WE'VE REACHED FCB 5D*= SMO FX1 [O/W SEARCH FOR FULLB. 5DSW BXU 0 SFULLB,XLP [J BACK IF NOT FULLB 5F#G SCHAIN 5FS6 STO 1 6 [PRESERVE FULLB PTR 5G?Q CHAIN 1,BPTR(2) [CHAI> IN FRONT OF NEXT FCB 5GRB LDX 2 6 [PICK UP FULLB PTR AGAIN 5H?2 LDX 0 BSPRE(3) [B.S. PREFIX OF FULLB 5HQL STO 0 A1+1(2) 5J== LDN 0 2 5JPW STO 0 A1(2) [R.H. OF FULLB 5K9G SFULONG 5KP6 SGETBAC 5L8Q LDX 3 BSPRE(3) 5LNB GETBACK 3 [GET 1 BLOCK 5M82 ADDSKIP I516A,BSGET 5MML LDX 1 3 [PRESERVE OLD B.S.PREFIX 5N7= #SKI K6INSERT>299-299 5NLW TRACE ACOMMUNE7(2),NEWBLOCK 5P6G CALL 6 SFCB3 [X3 ->FCB 5PL6 BXE 1 BSPRE(3),NOCHBSP [JIF BSPRE HASN'T CHANGED OVER COOR 5Q5Q LDX 2 ACOMMUNE7(2) 5QKB FREEBACK 1,2 [FREE BLOCK 5R52 ADDSKIP I516A,ADLFBL 5RJL CALL 6 SFCB3 5S4= BRN SGETBAC 5SHW NOCHBSP 5T3G LDX 2 FPTR(3) 5TH6 CALL 6 SFLP [X2 -> FULLB 5W2Q CALL 0 ZGEOER5 5WGB SMO 4 5X22 LDX 0 0(3) 5XFL SMO A1(2) [OLD BLOCK IN FULLB 5X^= STO 0 A1(2) 5YDW LDN 0 1 [UPDATE R.H 5YYG ADS 0 A1(2) 5^D6 SMO FX2 5^XQ LDX 6 ACOMMUNE7 [NEW BLOCK 62CB SMO 4 62X2 STO 6 0(3) [NGN BLOCK IN FCB 63BL CALL 1 SFINDFURB [X2 -> INSERT4 63W= #HAL FI+INSERT4,0 64*W STO 6 BACK2(2) [BLOCK NUMBER 64TG LDX 0 BSPRE(3) [ 65*6 STO 0 BACK1(2) [B.S.PREFIX. 65SQ MBS 3,BFALTR,BFALTB [INDICATE FILE & BLOCK NOS. ALTERED 66#B SBN 4 FBLKS-1 [CRT NO. 66S2 STO 2 6 [INSERT4 BLOLB 67?L MAPBSE 4,3 [SET BIT 67R= LDX 2 6 68=W ADN 4 FBLKS-1 68QG ADX 7 FX1 69=6 #SKI K6INSERT>399-399 69PQ TRACE 4,UPDATED 6=9B EXIT 7 0 6=P2 STEND 6?8L #SKI K6INSERT>399-399 6?N= TRACE 0,STEND 6#7W CALL 1 SFINDFURB [X2-> INSERT4 BLOCK 6#MG #HAL FI+INSERT4,0 6*76 EXIT 7 0 6*LQ # 6B6B # 6BL2 # THIS S/R MOVES DOWN AN AMOUNT OF CORE(IN AN USAIE BLOCK),OF SIZE 6C5L # [X0] BY [X1] 6CK= # THE AREA TO BE MOVED STARTS @ [X3] 6D4W # 6DJG MOVEDOWNB 6F46 #SKI K6INSERT>199$199 6FHQ TRACE 0,SIZE 6G3B #SKI K6INSERT>299$299 6GH2 TRACE 1,DOWN BY 6H2L #SKI K6INSERT 6HG= ( 6H^W BXGE 0 BSBS,ZGEOER6 [ERROR IF [X0] & [X1] ZERO,GREATER 6JFG BXGE 1 BSBS,ZGEOER7 [THAN GSBS,OR IF[X3] LESS THAN 4096. 6J^6 BZE 0 ZGEOER6 6KDQ BZE 1 ZGEOER7 6KYB LDN 4 -1 6LD2 BXL 3 4,ZGEOER10 6LXL ) 6MC= LDX 4 1 [SIZE OF SPACE TO BE CREATED 6MWW SMO FX1 [IF WE ARE ONLY MOVING DOWN 1 OR 2 6NBG BXL 1 THREE,STOLDX [WE TAKE SPECIAL ACTINO,FOR EOOICIENC 6NW6 BXGE 0 4,MOVELP [J IF MORE THAN ONE MOVE NECESSARY,OR THE 6P*Q ADX 0 1 [MOVE IS EXACTLY RIGHT 6PTB SMO 0 [SET NEW LAST WORD IN USAGE BLOCK ZERO 6Q*2 STOZ 0(3) 6QSL SBX 0 1 6R#= BRN MOVELAST [& GO TO DO ONLY MOVE. 6RRW MOVELP 6S?G [THIS IS THE AMOUNT WE HAVE TO 6SR6 LDX 5 0 [MOVE DOWN THE BLOCK 6T=Q ADX 5 3 [X5 POINTS TO THE BOTTOM OF THE 6TQB LDX 6 5 [AREA TO BE MOVED,X6 POINTS TO THE 6W=2 ADX 6 1 [ADD ON AMOUNT TO BE MOVED DOWN BY 6WPL SMO 6 [BOTTOM OF THE AREA TO BE MOVED INTO. 6X9= STOZ 0 [ZEROISE WORD AT END OF BLOCK 6XNW MOVELOOP 6Y8G # 6YN6 # WE CAN ONLY MOVE UP [X4]=[X1] WORDS AT A TIME,AS O/W WE WOULD 6^7Q # OVERWRIE THE DATA WE WOULD MOVE DOWN. 6^MB # 7272 SBX 5 4 [MOVE POINTERS UP TO POINT TO NEXT 72LL SBX 6 4 [AREAS TO BE MOVED TO & FROM. 736= #SKI K6INSERT>699-699 73KW ( 745G TRACE 1,MOVESIZE 74K6 TRACE 0,NO.LEFT 754Q ) 75JB MOVE 5 0(1) 7642 BXE 5 3,(7) [EXIT IF AREA TO BE MOVED IS AN EXACT 76HL [MULTIPLE OF [X4]. 773= SBX 0 4 [DECREMENT SIZE OF AREA LEFT TO 77GW BXGE 0 4,MOVELOOP [MOVE & JUMP BACK TO START OF LOOP. 782G MOVELAST [THIS CODE MOVES THE'REMAINDER' DOWN 78G6 #SKI K6INSERT>299-299 78^Q TRACE 0,LASTMOVE 79FB LDX 5 3 [FROM HERE 79^2 LDX 6 3 7=DL ADX 6 1 [TO HERE 7=Y= LDX 1 0 [SIZE OF LAST MOVE 7?CW MOVE 5 0(1) 7?XG EXIT 7 0 7#C6 # 7#WQ # IF WE ARE MOVING A LARGE AREA UP CFRE BY A SMALL DISTANCE IT IS 7*BB # POSSIBLE TO SAVE EXECUTION TIME SY USING A"LDX-STO"LOOP RATHER 7*W2 # THAN A MOVE LOOP.THE TRMES FOR TYPICAL IVSTRUCTION LOOPS ARE:- 7B*L # 7BT= # IF WE ARE MOVING MN WORDS FWON BY N WORDS, 7C#W # N = : 1 : 2 : 3 : 7CSG # : : : : 7D#6 # MOVE : 43M MS : 45.5M MS: 48M MS : 7DRQ # : : : : 7F?B # LDX/STO : 17.4M MS: 25.5M MS: 48.1M MS: 7FR2 # : : : : 7G=L # SO FOR [X1] =N=1 OR 2 WE USE A LDX/STO LOOP 7GQ= # 7H9W STOLDX 7HPG LDX 1 3 7J96 ADX 1 0 [X1 -> NEW LAST WORD OF DATA IN BLOCK 7JNQ SRC 4 1 [X4 =1 OR 2 AFTER SHIFT.IF 2 NOT NEGA 7K8B BPZ 4 TWOLP [J IF TWO 7KN2 STOZ 1(1) [ZEROISE WD @ END FO BLOCK 7L7L ONELOOP 7LM= SBN 1 1 [DECREMENT POINTER 7M6W LDX 6 0(1) [MOVE WORD DOWN BLOCK 7MLG STO 6 1(1) 7N66 BCT 0 ONELOOP 7NKQ SLC 4 1 [RESET X4 7P5B EXIT 7 0 7PK2 # 7Q4L # 7QJ= # 7R3W TWOLP [WE GO ROUND LOOP [([X0]/2)] TIMES & 7RHG SRC 0 1 [B0 OF X0 TELLS UF IF WE HAVE 1 MORE 7S36 STOZ 2(1) [WORD TO MOVE;SET IF X0 ORIGINALLY ODD. 7SGQ TWOLOOP [ALSO ZEROISE LAST WORD IN BLOC 7T2B SBN 1 2 [DECREMENT MODIFIER 7TG2 LDX 6 0(1) [MOVE TWO WRDS DOWN SY 2 7T^L STO 6 2(1) 7WF= LDX 6 1(1) 7WYW STO 6 3(1) 7XDG BCT 0 TWOLOOP 7XY6 BZE 0 NOTODD [IF ORIGINALLY EVEN NUMBER , JUMP 7YCQ LDX 6 0(3) [O/W STORE LAST OWRD 7YXB STO 6 2(3) 7^C2 NOTODD 7^WL SLC 4 1 [RESET X4 82B= EXIT 7 0 82TW # 83*G # THIS S/R CALCULATES THE KEY OF THE RECORD POINTED TO BY X3. 83T6 # X2 -> FCB.CALLED BY X4;X7=KEY ON EXIT+1;EXIT+0 IF UNKEYED 84#Q # 84SB SKEYREC 85#2 KEYREC 2,,3,(6),7 [CALCULATE KEY 85RL EXIT 6 1 86?= # 86QW # THIS S/R SETS X1 -> FI/FINDEXF BLOCK 87=G SFFBA 87Q6 SMO FX2 889Q LDX 0 AWORK2 88PB SFSTACK 0,1 8992 SFFB 89NL ADX 1 FBACKPOINT(1) [ -> FSTACK 8=8= SFFB1 8=MW LDX 1 FPTR(1) 8?7G BXE 1 CXFI,ZGEOER13 8?M6 LDX 0 ATYPE(1) 8#6Q BXE 0 FILEPLUSFCB,ZGEOER13 8#LB SMO FX1 8*62 BXU 0 SFINDEXF,SFFB1 8*KL EXIT 6 0 8B5= SFINDEXF 8BJW #HAL FI+FINDEXF,0 8C4G # 8CJ6 # 8D3Q # AFTER SORTING OUT MODE OF OPENING,GETTING A PTR TO THE FCB,ETC 8DHB # WE DEAL WITH THE EASY CASES 8F32 # 8FGL # INSERT CHAPTER. 8G2= # 8GFW # 1) INSERT/REPLACE AT END OF FILE;WE USE STEPAPPEND(WHICH DOES ALL 8G^G # THE'CAREFUL'BITS FOR US)& FOR INSERT,UPDATE THE READ PTRS. 8HF6 # 8HYQ # 2) REPLACE WHERE THE REPLACEE IS LARGER THAN THE REPLACER. 8JDB # 8JY2 # 3) NEXT WE TRY TO FIT THE'INSERTEE'OR'REPLACER' INTO THE USAGE 8KCL # BLOCK WE ALREADY HAVE. 8KX= # IF THIS SUCCEEDS,WE DO THE CAREFUL UPDATION IF ANY,AND PUT THE 8LBW # RECORD IN. IN THE CASE OF INSERT,UPDATE THE READ PTRS. 8LWG # 8MB6 # 8MTQ # INSERTWO CHAPTER. 8N*B # 8NT2 # (N.B. FOR MARK 6 WE ALWAYS GO FORWARDS) 8P#L # 4) WE CANNOT FIT THE NEW RECORD INTO THIS BLOCK. 8PS= # SO WE CALCULATE THE LESSER OF THE TWO OVERFLOWS,THE FORWARD , 8Q?W # (HOPING TO PUT THE DATA IN THE NEXT BLOCK) AND THE BACKWARD, 8QRG # (HOPING TO FIT OVERFLOW INTO THE PREVIOUS BLOCK). 8R?6 # N.B. THE FIRST & PENULTIMATE BLOCKS ALWAYS GO FORWARDS,THE LAST BLOC 8RQQ # GOES BACKWARDS.WE GO FORWARDS IF THE TWO OVERFLOWS ARE EQUAL. 8S=B # IF THE LESSER OVERFLOW IS GREATER THAN[X],WHICH CAN BE RESET BY 8SQ2 # MEND,BUT IS OPTIONALLY SET TO 128,WE DON'T ATTEMPT TO FIT THE 8T9L # OVERFLOW INTO THE CURRENT BLOCK,BUT GO TO 6) 8TP= # 8W8W # () WE READ DOWN THE APPROPRIATE BLOCK,AND HOPE TO FIT THE OVERFLOW 8WNG # IN.IF WE CAN'T WE GO TO 6).IF WE CAN,AND THE 2ND BLOCK,AFTER 8X86 # RECEIVING THE OVERFLOW,IS LESS THAN [PERCENT) FULL,(THIS BEING 8XMQ # THE OPTIMUM BLOCK PACKING DENSITY,AGAIN MENDABLE,OPTIONALLY 70% 8Y7B # WE ATTEMPT TO SHARE THE TWO BLOCKS,SUCH THAT THEY ARE BOTH 8YM2 # ABOUT EQUALLY PACKED (THEY'LL BOTH RE ABOUT 60%-70% FULL AFTER 8^6L # THAT). 8^L= # 925W # 92KG # INSERTHR CHAPTER. 9356 # 93JQ # 6) HAVING FAILED TO FIT THE OVERFLOW IN,WE HAVE TWO POSSIBILITIES; 944B # IN THE FIRST THE OVERFLOW IS LESS THAN'GSBS', SO WE CREATE A 94J2 # NEW BUFFER BLOCK,AND SHARE THE CONTENTS OF THE TWO BLOCKS + THE 953L # OVERFLOW BETWEEN THE THREE BUFFERS. 95H= # 962W # 96GG # INSERTFR CHAPTER. 9726 # 97FQ # 97^B # 7) THE OTHER CASE, OVERFLOW > GSBS,WE SET UP 2 NEW BUFFER BLOCKS, 98F2 # AND ATTEMPT TO SHARE OUT AS EQUALLY ASPOSSIBLE THE CONTENTS OF 98YL # THE BLOCKS & THE OVERFLOW. 99D= # 99XW # 9=CG # & IN GENERAL :- 9=X6 # 9?BQ # 9?WB # 8) IN ORDER TO SAVE REREADING THE USAGE BLOCKS,THEY ARE RENAMED 9#B2 # FOR THE DURATION OF THE SORTING. 9#TL # 9**= # 9) GREAT CARE HAS TO BE EXERCISED IN THE MORE COMPLEX CASES TO 9*SW # KEEP THE READ & APPEND PTRS ON THE RIGHT RECORD. 9B#G # 9BS6 # 10) THE EVENTUAL AIM OF ALL THIS TORTUOSITY IS TO KEEP THE FILES 9C?Q # OPERATED ON ABOUT 70% FULL.THE TWO PARAMETERS WE CAN USE TO 9CRB # TUNE THE SYSTEM ARE [X] & [PERCENT]. 9D?2 # 9DQL # 9F== # THE MARK 6 SYSTEM ONLY COPES WITH FORWARD OVERFLOW. 9FPW # 9G9G ZCOMPRESS 9GP6 CALL 7 ZTOP [CHECK MODE. 9H8Q LDCT 0 #201 [SET 'REPLACING LAST RECORD IN BLOCK' 9HNB ORS 0 AWORK1(2) [AND 'COMPRESS' BITS. 9J82 BRN MACMERJ 9JML XREPLACE 9K7= CALL 7 ZDEEP [CHECK DEPTH & MODE 9KLW BRN S1 9L6G ZREPLACE 9LL6 CALL 7 ZTOP [CHECK MODE 9M5Q S1 LDCT 0 #400 9MKB ORS 0 AWORK1(2) [SET 'REPLACE' BIT 9N52 ADDSKIP I516A,IREPL 9NJL BRN MACMERJ 9P4= XINSERT 9PHW CALL 7 ZDEEP [CHECK DEPTH & MODE 9Q3G BRN MCMERJ 9QH6 ZINSERT 9R2Q CALL 7 ZTOP [CHECK MODE 9RGB MCMERJ 9S22 ADDSKIP I516A,INSE1 9SFL MACMERJ 9S^= MHUNTW 1,FILE,FWB [X1 -> BLOCK CONTAINING NEW RECORD. 9TDW LDX 4 1 9TYG #SKI K6INSERT 9WD6 ( 9WXQ BNG 1 ZGEOER1 [ERROR IF NO FWB 9XCB LDEX 0 A1+FRH(1) 9XX2 #SKI K6INSERT>199-199 9YBL TRACE 0,SIZE INS 9YW= LDX 0 BRHMASK 9^*W ANDX 0 A1+FRH(1) 9^TG BNZ 0 ZGEOER1 =2*6 LDXC 0 AWORK1(2) =2SQ BCC NOREP29 [ J IF NOT REPLACE =3#B CALL 6 SFCB3 =3S2 LDX 2 3 [X2 -> FCB =4?L LDN 3 A1(1) [X3 -> RECORD =4R= CALL 6 SKEYREC [CALCULATE KEY IF ANY =5=W BRN NOINDEX [NONE =5QG LDX 2 FX2 =6=6 STO 7 AWORK4(2) [PRESERVE =6PQ BRN NOREP29 =79B NOINDEX =7P2 LDX 0 BIT10 [B10 => RECORD HAS NO KEY =88L LDX 2 FX2 =8N= ORS 0 AWORK1(2) =97W NOREP29 =9MG ) ==76 LDX 2 AWORK2(2) [DEPTH ==LQ STEPAGAIN 0(2) [CURRENT RECORD =?6B TESTREP OK,NOREHUNT [J IF HUNT NOT NECESSARY =?L2 MHUNTW 1,FILE,FWB =#5L STO 1 4 =#K= NOREHUNT =*4W LDX 1 4 =*JG BZE 3 YEOF [J IF END OF FILE. =B46 LDCT 0 #001 =BHQ ANDX 0 AWORK1(2) =C3B BZE 0 NOTEOF [J IF NOT COMPRESS =CH2 LDEX 0 FRH(3) =D2L ADX 3 0 [SKIP OVER LAST RECORD IN BLOCK. =DG= SMO FILERING(2) =D^W ADS 0 FREADWORD =FFG BRN NOTEOF =F^6 YEOF =GDQ # =GYB # INSERT & REPLACE @ E.O.F = APPEND. SO WE DO A STEP(APPEND) & =HD2 # MOVE THE RECORD; LAZY BUT EFFECTIVE. =HXL # =JC= #SKI K6INSERT>199-199 =JWW TRACE 3,INS EOF =KBG CALL 6 SFCB3 =KW6 LDX 7 FBLMOD(3) [SAVE FBLMOD,MAY NEED TO EXTEND INDEX =L*Q LDX 2 AWORK2(2) [DEPTH =LTB LDEX 1 A1+FRH(1) =M*2 ... STEP 0(2),0(1),ANSWER [THIS WILL DO ALL THE CAREFUL =MSL TESTREP FILEFULL,SFULL =N#= TESTREP OK,NOTHUNT [J IF HUNT NOT NECESSARY =NRW MHUNTW 2,FILE,FWB =P?G LDX 4 2 =PR6 NOTHUNT =Q=Q LDX 2 4 =QQB ADN 2 A1 =R=2 SMO 0(2) =RPL MOVE 2 0 [MOVE IN NOW RECORD =S9= CALL 6 SFCA2 [X2 -> FCA =SNW PSTAC 1,2 [X1 -> FSTACK =T8G BFCBX 1,1 [X1 -> FCB =TN6 SMO FX2 =W7Q LDXC 0 AWORK1 =WMB BCS ZUP [J IF REPLACE. =X72 LDX 0 FBLMOD(1) =XLL ADN 0 A1-1 =Y6= STO 0 FREADBLOCK(2) [UPDATE FREADBLOCK =YKW LDEX 0 FRH(3) =^5G ADX 0 CMOD(1) =^K6 STO 0 FREADWORD(2) [& F'WORD ?24Q ZUP ?2JB LDX 3 1 [X3 -> FCB ?342 SBX 7 FBLMOD(3) ?3HL BZE 7 NOALTFINDX [J IF FILE LONGER ?43= BRINDEX FINFC(3),NOALTFINDX [J IF NOT INDEXED ?4GW LDX 1 2 [X1 -> FCA ?52G CALL 6 SFFB [X1 -> FINDEX ?5G6 LDX 7 A1(1) ?5^Q ADN 7 1 ?6FB LDX 3 1 ?6^2 ALTLEN 3,7 [ALTLEN BY 1 ?7DL CALL 6 SFCB3 [X3 -> ?7Y= LDX 1 3 ?8CW CALL 6 SFFB1 [ X1 -> FINDEX AGAIN. ?8XG LDX 7 A1(1) ?9C6 ADN 7 1 [UPDATE R.H. ?9WQ STO 7 A1(1) ?=BB ADX 1 A1(1) [-> OFF END OF FINDEXF ?=W2 SBN 7 INDEXREC-A1+1 [J IF THERE WAS ALREADY ONE BLOCK ??*L BNZ 7 TTT [IN THE FILE BEFORE THE INSERT. ??T= STOZ A1-1(1) [O/W ZEROISE ONLY BLOCK-KEY ?##W BRN TTS [& MERGE ?#SG TTT ?*#6 LDX 0 A1-2(1) [NEW BLOCK-KEY = PREVIOUS ONE FOR NOW ?*RQ STO 0 A1-1(1) ?B?B TTS ?BR2 BS 3,BFINDEXALT [INDICATE INDEX ALTERED ?C=L CALL 6 SFCA2 ?CQ= NOALTFINDX ?D9W TESTREP FNEARLY,UPA ?DPG UP ?D^# ... TESTREP GLUTTON,UPA ?F96 SETREP OK ?FNQ UPA ?G8B LDX 2 3 [->FCB ?GN2 MHUNTW 3,FILE,FWB ?H7L ADN 3 A1 ?HM= CALL 6 SKEYREC [X7 CONTAINS KEY ?J6W BRN NOINDX ?JLG CALL 6 SFFBA [X1->FINDEXF ?K66 CALL 6 SFCA2 ?KKQ ADX 1 FREADBLOCK(2) ?L5B SBN 1 FBLKS-INDEXREC ?LK2 LDX 6 0(1) [=BLOCK KEY ?M4L BXGE 6 7,NOINDX [J IF INDEX NOT CHANGED ?MJ= PSTAC 3,2 ?N3W BFCBX 3,3 ?NHG LDCT 0 #001 ?P36 SMO FX2 ?PGQ ANDX 0 AWORK1 ?Q2B BZE 0 NOTPRESS [J IF NOT COMPRESS ?QG2 LDX 0 1(1) ?Q^L BXU 0 6,XALT [IF OLD BLOCK KEY FOR THIS BLOCK =KEY ?RF= STO 7 1(1) [NEXT BLOCK UPDATE NEXT BLK KEY ALSO. ?RYW BRN XALT ?SDG NOTPRESS ?SY6 #SKI K6INSERT ?TCQ ( ?TXB LDX 0 FREADBLOCK(2) ?WC2 SBN 0 A1-1 [ERROR IF NOT LAST BLOCK ?WWL BXU 0 FBLMOD(3),ZGEOER13 ?XB= ) ?XTW XALT ?Y*G BS 3,BFINDEXALT [INDICATE INDEX ALTERED ?YT6 STO 7 0(1) ?^#Q NOINDX ?^SB UP #2#2 NOTEOF #2RL #SKI K6INSERT #3?= ( #3QW LDX 0 FRH(3) [CHECK VALID R.H. #4=G ANDX 0 BRHMASK #4Q6 BNZ 0 ZGEOER2 #59Q LDXC 0 AWORK1(2) [J IF NOT REPLACE #5PB BCC NOREP30 #692 CALL 6 SFCA2 #6NL PSTAC 2,2 #78= BFCBX 2,2 [X2 -> FCA #7MW CALL 6 SKEYREC [X7 =KEY #87G BRN NOINX [NO KEY #8M6 LDX 0 BIT10 [B10 SET IF REPLACER NOT KEYED #96Q LDX 2 FX2 [REPLACEE IS ... #9LB ANDX 0 AWORK1(2) [ SO ... #=62 BNZ 0 ZGEOER13 [ERROR IF MISMATCH #=KL BXU 7 AWORK4(2),ZGEOER13 [OR INEQUALITY #?5= BRN NOREP30 #?JW NOINX ##4G LDX 0 BIT10 [IF RECORD KEYED ##J6 LDX 2 FX2 [ .... #*3Q ANDX 0 AWORK1(2) [BUT REPLACER NOT #*HB BZE 0 ZGEOER13 [...ERROR #B32 NOREP30 #BGL ) #C2= LDEX 0 FRH+A1(1) [STORE R.H.OF NEW RECORD #CFW SRC 0 9 [IN TOP 9 BITS OF AWORK3 #C^G STO 0 AWORK3(2) #DF6 LDX 0 AWORK1(2) [J IF INSERT #DYQ BPZ 0 PICKINSIZ #FDB LDEX 4 FRH(3) [R.H.OR REPLACEE #FY2 LDEX 0 A1+FRH(1) [COMPARE WITH REPLACER #GCL SBX 4 0 #GX= BNG 4 P2 [J IF FORMER SMALLER #HBW # #HWG # WE ARE HERE REPLACING A RECORD WITH A SMALLER ONE,OR ONE OF SAME #JB6 # SIZE #JTQ # #K*B #SKI K6INSERT>199-199 #KT2 TRACE 4,REPSMALL #L#L STO 4 AWORK4(2) [STORE X4 FOR END #LS= CALL 6 SFCA2 [X2 -> FCA #M?W SBX 3 FREADWORD(2) [X 3 -> FURB #MRG NAME 3, FI,INSERT4 [RENAME #N?6 LDX 4 FREADBLOCK(2) [X4-> BL. NO. #NQQ PSTAC 3,2 #P=B BFCBX 3,3 [X3 -> FCB #PQ2 CALL 7 SCAREFULA [DO ALL THE 'CAREFUL'RED TAPE. #Q9L [FOR REPLACING A BLOCK NUMBER #QP= LDX 3 2 [X3 -> FURB #R8W NAME 3,FILE,FUWB [RENAME BLOCK #RNG LDX 2 FX2 #S86 SMO ACOMMUNE5(2) [-> FCA #SMQ ADX 3 FREADWORD [X3 -> RECORD #T7B MHUNTW 2,FILE,FWB #TM2 LDEX 1 FRH(3) [PRESERVE R.H. #W6L ADN 2 A1 #WL= SMO 0(2) #X5W MOVE 2 0 [MOVE IN NEW RECORD #XKG BXE 1 0(2),NOMOVE [J IF REWRITE #Y56 ADX 1 3 [X1 -> R.H.OF NEXT RECORD(OLD POS'N) #YJQ ADX 3 0(2) [X3 -> WORD AFTER END OF RECORD NOW #^4B [IT'S BEEN REPLACED #^J2 LDEX 4 FRH(1) [IF LAST RECORD(MUST BE REPLACE)DON'T *23L BNZ 4 YMOVE [JUMP.PRESERVE X4=0 & ZEROISE NEW LAST *2H= STOZ 0(3) [WORD (NOT DONE FOR US BY MOVEDOWNB AS *32W BRN NOMOVE [WE DON'T ENTER IT *3GG YMOVE *426 LDX 2 1 [PRESERVE FOR MOVE *4FQ SLOOP LDEX 0 FRH(1) *4^B ADX 1 0 [LOOP TO SET X1 TO POINT TO ZERO *5F2 BNZ 0 SLOOP [WORD AT END OF BLOCK *5YL SBX 1 2 [GIVES AMOUNT TO MOVE *6D= #SKI K6INSERT *6XW BZE 1 ZGEOER6 *7CG #SKI K6INSERT>699-699 *7X6 TRACE 1,MOVE UP *8BQ MOVE 2 1(1) [+1 FOR ZERO WD. AT END OF BLOCK. *8WB NOMOVE *9B2 SMO FX2 *9TL LDX 2 ACOMMUNE5 *=*= PSTAC 3,2 [X 3 -> FSTAC *=SW BFCBX 3,3 [X3 -> FCB *?#G BS 3,BFALTR [INDICATE FILE ALTERED *?S6 BZE 4 NOLA [J IF REPLACING LAST RECORD *#?Q LDX 0 FBLMOD(3) *#RB ADN 0 A1-1 **?2 BXU 0 FREADBLOCK(2),NOLA [J IF NOT LAST BLOCK **QL LDXC 0 CMOD(3) *B== BCS NOLA [J IF CMOD <0 *BPW SMO FX2 *C9G LDX 0 AWORK4 [PICK UP "EXCISION" *CP6 SBS 0 CMOD(3) [UPDATE CMOD *D8Q NOLA *DNB LDX 0 FBLMOD(3) *F82 SBN 0 FBLKS-A1-FNEARLY *FML SBX 0 FSIZE(3) *G7= BNG 0 UP [J IF NOT"NEARLY FULL" *GLW UPF *H6G #SKI K6INSERT>99-99 *HL6 TRACE FBLMOD(3),FNEARLY *J5Q SETREP FNEARLY *JKB BRN UPA *K52 # *KJL # WE HAVE AN INSERT OR REPLACE "WITH LARGER RECORD"(EXPAND). *L4= # *LHW # IF THE EXTRA DOESNT FIT WE GO ACROSS TO INSERTWO. *M3G # *MH6 P2 *N2Q NGX 5 4 [INVERT- GIVES EXTRA SIZE NEEDED *NGB BRN P1 *P22 PICKINSIZ *PFL LDEX 5 A1+FRH(1) [PICK UP R.H. FROM FWB *P^= P1 *QDW #SKI K6INSERT>199-199 *QYG TRACE 5,EXTRA *RD6 DEX 5 AWORK1(2) [STORE "EXTRA" *RXQ CALL 6 SFCA2 [X2-: FCA *SCB SBX 3 FREADWORD(2) [X3 -> USAGE BLOCK *SX2 NAME 3,FI,INSERT4 [RENAME USAGE BLOCK *TBL LDX 4 FREADBLOCK(2) [BLOCK WE WANT REPLACED *TW= PSTAC 3,2 *W*W BFCBX 3,3 [X3 -> FCB *WTG CALL 7 SCAREFULA [DO THE LGR UPDATING *X*6 LDX 3 2 [X3 -> FI/INSERT4 BLOCK *XSQ LDX 2 FX2 *Y#B SMO ACOMMUNE5(2) [-> FCA *YS2 ADX 3 FREADWORD [X3 -> RECORD *^?L CALL 7 SENDBLOCK [SET X1 -> END OF BLOCK *^R= LDX 0 AWORK1(2) B2=W BPZ 0 NREP1 [J IF INSERT B2QG LDEX 0 FRH(3) B3=6 ADX 0 3 [J IF REPLACEE IS NOT LAST RECORD B3PQ BXU 0 1,NREP1 [OF BLOCK B49B #SKI K6INSERT>299-299 B4P2 TRACE 0,LAST REP B58L LDCT 0 #200 [SET A BIT TO B5N= ORS 0 AWORK1(2) [REMIND US B67W NREP1 B6MG LDX 2 ACOMMUNE5(2) [-> FCA B776 SBX 1 3 [AREA AFTER RECORD B7LQ LDX 0 1 [PLAY AROUND WITH IT B86B ADX 0 FREADWORD(2) [THE AIM OF ALL THIS IS TO CALCULATE B8L2 SMO FX2 B95L ADS 0 AWORK3 [AMT USED IN INSERT1+A1 B9K= SBN 0 GSBS-1+A1 [THE ROOM LEFT B=4W NGX 0 0 [IN THE BLOCK B=JG SBX 3 FREADWORD(2) [X3 -> FURB B?46 BXL 0 5,NOROOM [J IF LE>5 THAN AREA NEEDED B?HQ # WE THINK THE NEW RECORD FITS; LET'S HOPE WE'RE RIGHT B#3B #SKI K6INSERT>199-199 B#H2 TRACE 0,IT FITS! B*2L NAME 3,FILE,FUWB [RENAME USAGE BLOCK B*G= ADX 3 FREADWORD(2) [X3 -> RECORD B*^W LDX 4 5 [AMOUNT EXTRA WE NEED IN BLOCK. BBFG MHUNTW 2,FILE,FWB BB^6 ADN 2 A1+FRH BCDQ LDCT 0 #200 [IS "REPLACING LAST RECORD IN BLOCK" BCYB SMO FX2 [BIT SET BDD2 ANDX 0 AWORK1 BDXL BZE 0 MV1 [J IF NOT BFC= SMO 0(2) BFWW STOZ 0(3) [ZEROISE NEW WD @ END OF BLOCK BGBG BRN NMV1 [& J TO MOVE NEW RECORD IN BGW6 MV1 BH*Q LDX 0 1 [SIZE BHTB LDX 1 5 [DOWN BY BJ*2 CALL 7 MOVEDOWNB BJSL NMV1 BK#= SMO 0(2) BKRW MOVE 2 0 [MOVE IN NOW INCFRD BL?G LDX 2 FX2 BLR6 LDCT 0 #401 BM=Q ANDX 0 AWORK1(2) BMQB LDX 2 ACOMMUNE5(2) BN=2 BNZ 0 TESTAPP [J IF REPLACE OR COMPRESS BNPL ADS 4 FREADWORD(2) [OTHERWISE UPDATE READ PTR. BP9= TESTAPP BPNW PSTAC 3,2 BQ8G BFCBX 3,3 [X3 -> FCB BQN6 BS 3,BFALTR [INDICATE FILE ALTERED BR7Q LDX 0 FBLMOD(3) BRMB ADN 0 A1-1 BS72 BXU 0 FREADBLOCK(2),NOLA [J IF NOT LAST BLOCK BSLL LDX 0 CMOD(3) [DON'T UPDATE CMOD IF NOT YET BT6= BNG 0 NOLA [CALCULATED BTKW LDCT 0 #200 [IF REPLACING BW5G SMO FX2 [LAST RECORD IN BWK6 ANDX 0 AWORK1 [BLOCK, IGNORE CMOD BX4Q BNZ 0 NOLA BXJB ADS 4 CMOD(3) [UPDATE APPEND PTRS BY42 BRN NOLA BYHL NOROOM B^3= #SKI K6INSERT>199-199 B^GW TRACE 0,NO.ROOM C22G NAME 3,FI,INSERT1 [RENAME BLOCK. C2G6 ACROSS INSERTWO,1 [GO ACROSS TO DO DIFFICULT CASES. C2^Q # ENVIRONMENT ON EXIT:- C3FB # C3^2 # THERE IS A FI/INSERT1 BLOCK IN THE FILE CHAIN,FOR WHICH THE CARE- C4DL # FUL UPDATING HAS BEEN DONE (IF APPROPRIATE) C4Y= # C5CW # AWORK1 CONTAINS SOME SWITCHES & SIZE EXTRA REQUIRED C5XG # C6C6 # AWORK2 CONTAINS THE DEPTH C6WQ # C7BB # AWORK3 CONTAINS THE AMOUNT USED IN THE INSERT1 BLOCK +A1 C7W2 # C8*L # ACCUMULATORS - RUBBISH C8T= # C9#W # C9SG # FILEFULL EXIT C=#6 # C=RQ SFULL C??B ACROSS INSERTFR,2 C?R2 [ C#=L MENDAREA K6INSERT/5<100>30,K99INSERT C#Q= #END ^^^^ ...54644145000500000000