INSERTHR6

(George Source)

Macros used: ACROSS, ADDSKIP, ALTLEN, BFCBX, BLOCK, BXE, BXGE, BXL, BXU, CHAIN, DOWN, FREEBACK, GEOERR, GETBACK, JBC, MAPBCH, MAPBSE, MBS, MENDAREA, MHUNTW, NAME, PSTAC, SEGENTRY, SETNCORE, SETREP, SFSTACK, TESTREP, TRACE, UP

INSERTHR6.txt
22FL    #SEG  INSERTHR6                    [ JUDY BIDGOOD   
22^=    #OPT  K0INSERTHR=K0INSERT>K0ACCESS>K0FILESTORE>K0ALLGEO 
23DW    #LIS  K0INSERTHR
23YG        8HINSERTHR  
24D6    [   
24XQ          SEGENTRY K1INSERTHR,X1INSERTHR
25CB    [   
25X2    #     ERRORS
26BL    ZGEOER1 
26W=          GEOERR 1,BACKWARD            [MARK SEVEN CODE BEING OBEYED
27*W    ZGEOER2 
27TG          GEOERR  1,ZEROREC            [ZERO RECORD MET UNEXPECTEDLY
28*6    ZGEOER3 
28SQ          GEOERR   1,AVERAGE!          [AVERAGE CONTENTS OF BLOCK  RIDICULOU
29#B    ZGEOER4 
29S2          GEOERR   1,EMPTYBIT          ["EMPTY BLOCK" BIT SET ON ENTRY. 
2=?L    ZGEOER5 
2=R=          GEOERR  1,FULLBGON           [FULLB GONE.OUGHT TO BE PRESENT  
2?=W    ZGEOER6 
2?QG          GEOERR  1,ZERODOWN           [UNEXPECTED ZERO MOVE IN INSERTHR
2#=6    ZGEOER7 
2#PQ          GEOERR  1,BIG REC            [UNABLE TO SHARE BLOCKS SATISFACTORIL
2*9B    ZGEOER8 
2*P2          GEOERR  1,OVERFULL            [>512 WORDS IN MIDDLE BLOCK !   
2B8L    ZGEOER9 
2BN=          GEOERR  1,NO BLOCK           [ERROR IN SFINDFURB S/R. 
2C7W    ZGEOER10
2CMG          GEOERR   1,CARE ???          [FREADBLOCK UNREASONABLE 
2D76    ZGEOER11
2DLQ          GEOERR  1,ENDBLOCK           [INSERT REACHED E.O.B. UNEXPECTEDLY. 
2F6B    #   
2FL2    SFULLB  
2G5L    #HAL  BSTB+FULLB,0  
2GK=    KXINSERTHR  
2H4W    X   
2HJG          +GSBS/4  [THISPARAMETER DECIDES THE MAXIMUM AMOUNT OF OEVRFLOW
2J46                   [WE TRY TO FIT INTO AN ADJACENT BLOLK
2JHQ    KPINSERTHR  
2K3B    PERCENT 
2KH2          +GSBS*3/10  [THIS PARAMEJER DETERMINES THE MINIMUM'FULLNESS'  
2L2L                   [BEYOND WHICH WE DON'T "SHARE" BLOCKS.   
2LG=    #   
2L^W    #   
2MFG    #     SUBROUTINES   
2M^6    #   
2NDQ    #   
2NYB    SFCB3          [SET X3-> FCB
2PD2          SMO      FX2  
2PXL          LDX   0  AWORK2   
2QC=          SFSTACK  0,3                 [X3 -> FCA   
2QWW          SMO      FX2  
2RBG          STO   3  ACOMMUNE5           [STORE   
2RW6          PSTAC    3,3  
2S*Q          BFCBX    3,3                 [X3 -> FCB   
2STB          EXIT  6  0
2T*2    #   
2TSL    SENDBLOCK   
2W#=          LDX   1  3                   [X3 &X1 -> NEXT RECORD   
2WRW    SEBLP   
2X?G          LDEX  0  FRH(1)              [NEXT R.H
2XR6          ADS   0  1                   [ADD INTO PTR
2Y=Q          BNZ   0  SEBLP               [J BACK IF NON ZERO  
2YQB          EXIT  7  0                   [EXIT
2^=2    #   
2^PL    SFURB   
329=          SMO      FX2  
32NW          LDX   0  AWORK2              [SET X2 - > FSTACK   
338G          SFSTACK  0,2  
33N6          SMO      FX2  
347Q          STO   2  ACOMMUNE5           [-> FCA  
34MB    SFFURB  
3572          PSTAC    2,2  
35LL          BRN      SFFULP   
366=    SFINDFURB   
36KW    #     CALLED BY X1.THE WORD AFTER THE CALL CONTAINS THE TYPE/SUBTYPE
375G    #     WANTED.X3 ->FCB,X2 WILL POINT ON EXIT TO THE BLOCK REQUIRED.  
37K6          LDX   2  FPTR(3)             [J OVER FSTACK BLOCK 
384Q    SFFULP  
38JB          LDX   2  FPTR(2)             [NEXT BLOCK  
3942          BXE   2  CXFI,ZGEOER9 
39HL          LDX   0  ATYPE(2) 
3=3=    #SKI  K6INSERT  
3=GW          BXE   0  FILEPLUSFCB,ZGEOER9  
3?2G          BXU   0  0(1),SFFULP         [J IF WRONG TYPE 
3?G6          EXIT  1  1                   [EXIT ROUND TYPE-WORD
3?^Q    #   
3#FB    #   
3#^2    SFINDFULLB     [SET X3 ->FCB,X2-> APPROPRIATE FULLB 
3*DL    #     CALLED BY X6,OVERWRITES X2,WHICH POINTS TO AN  APPROPRIATE FULLB  
3*Y=    #     FOR THIS FILE ON SUCCESSFUL EXIT (+1) 
3BCW    #     EXIT +0 => NO FULLB   
3BXG    #     X3 POINTS TO FCB. 
3CC6          SMO      FX2  
3CWQ          LDX   0  AWORK2   
3DBB          SFSTACK  0,2,2               [FIND X2 -> FSTACK   
3DW2          BFCBX    3,2                 [X3 -> FCB   
3F*L    SFLP  LDX   2  FPTR(2)             [NEXT BLOCK  
3FT=          BXE   2  CXFI,(6)            [J OUT IF END OF CHAIN   
3G#W          LDX   0  ATYPE(2)            [TYPE
3GSG          BXE   0  FILEPLUSFCB,(6)     [EXIT FCB, SEARCH UNSUCCESSFUL   
3H#6          SMO      FX1  
3HRQ          BXU   0  SFULLB,SFLP         [J IF NOT BSTB/FULLB 
3J?B          LDX   0  A1+1(2)  
3JR2          BXU   0  BSPRE(3),SFLP       [J IF WRONG B.S.PREFIX.  
3K=L          EXIT  6  1
3KQ=    #   
3L9W    SFCA2   
3LPG          SMO      FX2  
3M96          LDX   0  AWORK2              [DEPTH   
3MNQ          SFSTACK  0,2                 [X2 -> FCA   
3N8B          SMO      FX2  
3NN2          STO   2  ACOMMUNE5
3P7L          EXIT  6   0   
3PM=    #   
3Q6W    #   
3QLG    SCAREFULA   
3R66    #     THIS  ROUTINE DOES ALL THE CAREFUL UPDATING FOR 1 BLOCK HAVING
3RKQ    #     BEEN CHANGED. IF NECESSARY A BSTR/FULLB IS SET UP,OR ALTLEN'ED,   
3S5B    #     AND THE BLOCK NO. IS SWAPPED OVER 
3SK2    #   
3T4L    #     OVERWRITES  X1,2,3,6, CALLED BY X7
3TJ=    #     X4 THROUGHOUT INDICATES WHICH BLOCK NUMBER TO CHANGE (A FREADBLOCK
3W3W    #     TYPE  PTR REL. TO AD OF THE FCB); 
3WHG    #     ON EXIT  X2 -> THE USAGE BLOCK; THIS IS ASSUMED TO BE A   
3X36    #     FI/INSERT4 BLOCK  
3XGQ    #   
3Y2B    SCAREFULA1  
3YG2    #SKI  K6INSERT>99-99
3Y^L          TRACE    4,CAREFUL
3^F=    #SKI  K6INSERT<99$99
3^YW          BXGE  4  BSBS,ZGEOER10
42DG          JBC      STEND,3,BFCARE      [EXIT IF NOT CAREFUL 
42Y6          LDX   0  4                   [BLOCK WE'RE INTERESTED IN   
43CQ          SBN   0  FBLKS-1             [DATUMISE
43XB          MAPBCH   0,3                 [TEST IF BIT SET IN FMAPP BLOCK. 
44C2          BNZ   0  STEND               [EXIT IF IT IS   
44WL          SBX   7  FX1                 [DATUMISE LINK   
45B=          JBC      NEWFULLB,3,BFALTR   [IF FILE NOT ALTERED,SET UP A FULLB  
45TW          CALL  6  SFINDFULLB          [X2-> FULLB,X3-> FCB 
46*G          BRN      NEWFULLB            [J IF FULLB NOT PRESENT  
46T6          LDX   6  ALOGLEN(2)          [NOW ALTLEN FULLB
47#Q          ADN   6  1
47SB          LDX   3  2
48#2          ALTLEN  3,6                  [BY ONE WORD 
48RL          CALL  6  SFINDFULLB          [X2-> FULLB,X3->FCB  
49?=          CALL  0  ZGEOER5             [ERROR IF UNSUCCESSFUL,X0 TELLS US   
49QW          BRN      SFULONG             [WHENCE WE CAME FOR GEOERR.  
4==G    NEWFULLB
4=Q6          SETNCORE  3,1,BSTB,FULLB     [SET UP FUUB,X1 -> IF
4?9Q          CALL  6  SFCB3               [X3 ->FCB
4?PB          LDX   2  3                   [X1 -> FCB   
4#92    XLP 
4#NL          LDX   2  FPTR(2)             [NEXT BLOCK IN FILE CHAIN.   
4*8=          BXE   2  CXFI,SCHAIN         [J IF END OF FILE CHAIN. 
4*MW          LDX   0  ATYPE(2) 
4B7G          BXE   0  FILEPLUSFCB,SCHAIN  [J IF WE'VE REACHED FCB  
4BM6          SMO      FX1                 [O/W SEARCH FOR FULLB.   
4C6Q          BXU   0  SFULLB,XLP          [J IF NOT FULLB  
4CLB    SCHAIN  
4D62          STO   1  6                   [PRESERVE
4DKL          CHAIN    1,BPTR(2)           [CHAI> IN FRONT OF NEXT FCB  
4F5=          LDX   2  6             [FULLB PTR 
4FJW          LDX   0  BSPRE(3)            [B.S. PREFIX OF FULLB
4G4G          STO   0  A1+1(2)  
4GJ6          LDN   0  2                   [R.H.
4H3Q          STO   0  A1(2)               [R.H. OF FULLB   
4HHB    SFULONG 
4J32    SGETBAC 
4JGL          LDX   3  BSPRE(3) 
4K2=          GETBACK  3                   [GET 1 BLOCK 
4KFW          ADDSKIP  I516A,BSGET  
4K^G          LDX   1  3
4LF6          CALL  6  SFCB3              [X3->FCB  
4LYQ          BXE   1  BSPRE(3),OKBLOK     [JIF BSPRE HASN'T CHANGED OVER COOR  
4MDB          LDX   2  ACOMMUNE7(2) 
4MY2          FREEBACK 1,2                 [FREE BLOCK  
4NCL          ADDSKIP  I516A,ADLFBL 
4NX=          CALL  6  SFCB3
4PBW          BRN      SGETBAC  
4PWG    OKBLOK  
4QB6          LDX   2  FPTR(3)  
4QTQ          CALL  6  SFLP                [X2 -> FULLB 
4R*B          CALL  0  ZGEOER5  
4RT2          SMO      4
4S#L          LDX   0  0(3) 
4SS=          SMO      A1(2)               [OLD BLOCK IN FULLB  
4T?W          STO   0  A1(2)
4TRG          LDN   0  1                   [UPDATE R.H  
4W?6          ADS   0  A1(2)
4WQQ          SMO      FX2  
4X=B          LDX   6  ACOMMUNE7           [NEW BLOCK   
4XQ2          SMO      4
4Y9L          STO   6  0(3)                [NGN BLOCK IN FCB
4YP=          CALL  1  SFINDFURB           [FIND USAGE BLOCK
4^8W    #HAL  FI+INSERT4,0  
4^NG          STO   6  BACK2(2)            [BLOCK NUMBER
5286          LDX   0  BSPRE(3)            [
52MQ          STO   0  BACK1(2)            [B.S.PREFIX. 
537B          MBS      3,BFALTR,BFALTB     [INDICATE FILE & BLOCK NOS. ALTERED  
53M2          STO   2  6                   [INSERT4 BLOCK   
546L          SBN   4  FBLKS-1  
54L=          MAPBSE  4,3                  [SET BIT IN FMAPP BLOCK  
555W          ADN   4  FBLKS-1  
55KG          LDX   2  6
5656          ADX   7  FX1  
56JQ          EXIT  7  0
574B    STEND   
57J2          CALL  1  SFINDFURB           [X2 -> INSERT4 BLOCK 
583L    #HAL  FI+INSERT4,0  
58H=          EXIT  7  0
592W    #   
59GG    #   
5=26    #     THIS  S/R DOES THE CAREFUL UPDATING FOR A NEW BLOCK; A BIT HAS TO 
5=FQ    #     BE INSERTED IN THE FMAP BLOCK,AND A BLOCK NO. INSERTED IN THE 
5=^B    #     FCB   
5?F2    #   
5?YL    #     OVERWRITES X1,X2,X3,X6,X5; X4 POINTS TO BLOCK NO. BEFORE WHICH THE
5#D=    #     BLOCK IS TO BE INSERTED. IN THE CASE OF     NON-CAREFUL FILES,WE  
5#XW    #     CAN USE AN UNUSED BL.NO.,   IF ANY;O/W WE MUST GET A NEW ONE. 
5*CG    #     X2 ON EXIT -> USAGE BLOCK 
5*X6    SINSERT 
5BBQ    SINSERT1
5BWB          SBX   7  FX1  
5CB2          DOWN     INSERTBL,2          [INSERT BLOCK NUMBER 
5CTL          TESTREP  FILEFULL,SFULL   
5D*=          ADX   7  FX1  
5DSW          CALL  1  SFURB               [X2         -<INSERT2
5F#G    #HAL  FI+INSERT3,0  
5FS6          EXIT  7  0
5G?Q    #   
5GRB    SFULL                              [FILEFULL EXIT   
5H?2          ACROSS   INSERTFR,2   
5HQL    #   
5J==    #     THIS S/R MOVES DOWN AN AMOUNT OF CORE(IN AN USAIE BLOCK),OF SIZE  
5JPW    #     [X0]   BY  [X1]   
5K9G    #     [X3]  ->  START OF AREA TO BE MOVED   
5KP6    #   
5L8Q    MOVEDOWNB   
5LNB    #SKI  K6INSERT>199-199  
5M82    (   
5MML          TRACE    0,SIZE   
5N7=          TRACE    1,DOWN BY
5NLW    )   
5P6G          LDX   4  1                   [SIZE OF SPACE TO BE CREATED 
5PL6                                       [THIS IS AMOUNT WE HAVE TO   
5Q5Q          LDX   5  0         [MOVE DOWN BLOCK   
5QKB          ADX   5  3                   [X5   POINTS TO THE BOTTOM OF THE
5R52          LDX   6  5                   [AREA TO BE MOVED,X6 POINTS TO THE   
5RJL          ADX   6  1
5S4=          SMO      6                   [BOTTOM OF THE AREA TO BE MOVED INTO.
5SHW          STOZ     0                   [ZEROISE WORD AT END OF BLOCK
5T3G    MOVELOOP       [   WE CAN ONLY MOVE DOWN [X4]=[X1] WORDS AT A TIME(OR   
5TH6                   [LESS,OF COURSE),FOR FEAR OF OVERWRITING WE START AT THE 
5W2Q          BXL   0  4,MOVELAST          [BOTTOM.J IF AMOUNT LEFT TO MOVE IS  
5WGB                                       [NOW LESS THAN MAXIMUM.  
5X22          SBX   5  4                   [MOVE POINTERS UP TO POINT TO NEXT   
5XFL          SBX   6  4                   [AREAS TO BE MOVED TO & FROM.
5X^=          MOVE  5  0(1) 
5YDW          BXE   5  3,(7)               [EXIT IF AREA TO BE MOVED IS AN EXACT
5YYG                                       [MULTIPLE OF [X4].   
5^D6          SBX   0  4                   [DECREMENT SIZE  OF AREA LEFT TO 
5^XQ          BRN      MOVELOOP            [MOVE AND JUMP BACK TO START OF LOOP 
62CB    MOVELAST                           [THIS CODE MOVES THE'REMAINDER' DOWN 
62X2          LDX   1  0                   [SIZE OF LAST MOVE   
63BL          LDX   5  3                   [FROM HERE   
63W=          LDX   6  3
64*W          ADX   6  4                   [TO HERE 
64TG          MOVE  5  0(1) 
65*6          EXIT  7  0
65SQ    #   
66#B    #   
66S2    #   
67?L    #     THIS  SEGMENTS EXPECTS A FI/INSERT1, A FI/INSERT3, AND THE INSERTE
67R=    #    -REPLACEE IN A FILE/FWB.IT SETS UP A FI/INSERT2 BLOCK, SMOOTHS 
68=W    #     THE DATA IN THE FIRST THREE BLOCKS INTO THE THREE INSERT BLOX,
68QG    #     AND INSERTS THE EXTRA AT THE SAME TIME.   
69=6    #   
69PQ    #   
6=9B    #     ON ENTRY:-
6=P2    #   
6?8L    #     AWORK1  :-BOTTOM 9 BITS = SIZE EXTRA NEEDED(I.E. SURPLUS OF REPL- 
6?N=    #               ACER OVER REPLACEE,OR SIZE OF INSERTEE) 
6#7W    #     AWORK3  :- B0-8:SIZE OF RECORD(FROM FWB)  
6#MG    #              B15-23:A1+AREA USED IN INSERT1 BLOCK 
6*76    #     AWORK4  :-A1+ AREA USED IN INSERT3 BLOCK  
6*LQ    #   
6B6B    #     X5      :- +1 IF FORWARD,-1 IF BACKWARD.  
6BL2    #   
6C5L    X1INSERTHR  
6CK=    #SKI  K6INSERT  
6D4W    (   
6DJG          LDCT  0  #14                 [ERROR IF"EMPTY BLOCK" & "EMPTY BLOCK
6F46          ANDX  0  AWORK1(2)           [@ EOF" BITS SET 
6FHQ          BNZ   0  ZGEOER4  
6G3B    )   
6GH2          LDN   5  1                   [SET X5 =+1 IF FORWARD   
6H2L          LDCT  0  #40  
6HG=          ANDX  0  AWORK1(2)
6H^W          BNZ   0  NOBAK47  
6JFG          NGN   5  1                   [       =-1 IF BACKWARD  
6J^6    NOBAK47 
6K2C ...      SETNCORE GSBS,1,FI,INSERT3   [ACTUALLY AN INSERT2 BLOCK   
6K3N ...      CALL  6  SFCA2               [X2 -> FCA   
6K4^ ...      LDX   4  FREADBLOCK(2)
6K6= ...      BNG   5  N5                  [WE'RE GOING TO INSERT A BLOCK NO IN 
6K7H ...      ADN   4  1                   [THE FCB. IF WE'RE GOING BACKWARDS,US
6K8S ...N5                                 [X4->FREADBLOCK,IF FORWARD F'BLOCK +1
6K=5 ...      PSTAC    3,2  
6K?B ...      CHAIN    1,3                 [CHAIN INSERT2 INTO FILE CHAIN   
6K#M ...      CALL  7  SINSERT1            [INSERT BLOCK NO.
6K*Y ...      NAME     2,FI,INSERT2        [RENAME BLOCK CORRECTLY. 
6KC9 ...      STOZ     A1(2)
6KDQ          ADDSKIP  I516A,INSE3  
6KYB          CALL  1  SFURB               [X2 -> INSERT3 BLOCK 
6LD2    #HAL  FI+INSERT3,0  
6LXL          NAME  2,FI,INSERT4           [RENAME  
6MC=          LDX   2  FX2  
6MWW          LDX   2  ACOMMUNE5(2)        [-> FCA  
6NW6    #SKI  K6INSERT>99$99
6P*Q          TRACE    FREADWORD(2),INSERTHR
6PTB          ADX   4  5                   [X4 -> BLOCK NO. 
6Q*2          PSTAC  2,2
6QSL          BFCBX    3,2                 [X3 -> FCB   
6R#=          CALL  7  SCAREFULA1          [CAREFUL UPDATING
6RRW          NAME  2,FI,INSERT3           [RERENAME BLOCK. 
6^MB          LDX   1  FX2  
7272          LDEX  7  AWORK1(1)           [EXTRA NEEDED
72LL          LDX   0  AWORK3(1)
736=          ANDN  0  -1                  [SIZE USED IN INSERT1
73KW          ADX   7  0                   [+AMT.USED IN INSERT1 BLOCK +A1  
745G          ADX   7  AWORK4(1)           [+ AMOUNT USED IN INSERT3 BL. +A1
74K6          SBN   7  A1*2                [- A1*2  
754Q          STOZ     6                   [DOUBLE-LENGTH   
75JB          LDN   0  3                   [DIVISOR 
7642          DVR   6  0                   [X7 NOW CONTAINS AVGE. IN 3 BLOK.
76HL    #SKI  K6INSERT>99-99
773=          TRACE  7,SMOOTH 3 
77GW          STO   7  ACOMMUNE1(1)        [STORE IN ACOMMUNE1  
782G    #SKI  K6INSERT  
78G6    (   
78^Q          BXGE  7  BSBS,ZGEOER3 
79FB          LDN   0  GSBS/3-1 
79^2          BXGE  0  7,ZGEOER3
7=DL    )   
7=Y=    #   
7?CW    #     USE OF ACOMMUNE WORDS.
7?XG    #   
7#C6    #     ACOMMUNE1 :- THE IDEAL EVENTUAL AVERAGE PACKING DENSITY IN THE
7#WQ    #                  THREE USAGE BLOX.
7*BB    #     ACOMMUNE2 :- POINTER TO INSERT2 BLOCK 
7*W2    #     ACOMMUNE3 :- POINTER TO INSERT1 OR INSERT3 BLOCK  
7B*L    #     ACOMMUNE4 :- CUMULATIVE TOTAL OF WORDS MOVED INTO THE INSERT2 BLOC
7BT=    #     ACOMMUNE5 :- POINTER TO FCA   
7C#W    #     ACOMMUNE6 :- MOSTLY UNUSED
7CSG    #   
7D#6    #     FIRSTLY WE DECIDE WHETHER THE INSERTEE/REPLACEE IS TO GO INTO THE 
7DRQ    #     INSERT1 OR INSERT2 BLOCK. IF THE LATTER,WE JUMP TO "RECINS2". 
7F?B    #     FOR THE FIRST CASE,WE CALCULATE HOW MUCH OF THE INSERT1 BLOCK IS  
7FR2    #     TO GO INTO THE INSERT2 BLOCK,MOVE IT ACROSS.THEN WE MOVE DOWN THE 
7G=L    #     REST  OF THE INSERT1 BLOCK & MOVE IN THE NEW RECORD.  
7GQ=    #   
7H9W          BNG   5  SHAR3BAK            [J IF BACKWARD.  
7H*R ...      LDX   2  ACOMMUNE5(1)      [X2 -> FCA 
7HFN ...      CALL  1  SFFURB   
7HKK ...#HAL  FI+INSERT2,0                 [X2 -> INSERT2 BLOCK 
7HMH ...      LDX   1  FX2  
7HPG          STO   2  ACOMMUNE2(1)        [-> INSERT2 BLOCK
7J96          LDX   2  ACOMMUNE5(1)        [-> FCA  
7JNQ          LDX   4  FREADWORD(2)        [PRESERVE F'WORD 
7K8B          CALL  1  SFFURB              [X2 -> INSERT1 BLOCK 
7KN2    #HAL  FI+INSERT1,0  
7L7L          LDX   1  FX2  
7LM=          STO   2  ACOMMUNE3(1)        [ACOM3 -> INSERT1 BLOCK  
7M6W          LDX   5  4                   [PRESERVE F'WORD.
7MLG          SBN   4  A1   
7N66          BXGE  4  7,RECINS2           [IF F'WORD IS > AVGE ALLOWED IN BLOCK
7NKQ                                       [THE INSERTEE/REPLACEE GOES INTO THE 
7P5B                                       [INSERT2 BLOCK   
7SGQ          LDX   6  AWORK3(1)           [J IF THE SIZE OF THE NEW RECORD 
7T2B          SRL   6  15                  [IS GREATER THAN THE AVERAGE 
7TG2          BXGE  6  7,VLARGEREC  
7T^L ...      LDX   0  6
7WF=          SRA   0  1                   [HALVE IT(+1 TO BE ON THE SAFE SIDE) 
7WYW          ADX   0  4                   [SIMILARLY IF THE I/R.IS > AVGE. BY  
7XDG          BXL   7  0,RECINS2           [MORE THAN 1/2 ITS SIZE  
7XY6    VLARGEREC   
7YCQ ...      ADX   4  6                   [SIMILARLY IF IT DOESN'T FIT.
7^C2          BXGE  4  BSBS,RECINS2 
7^WL    #SKI  K6INSERT>99$99
82B=          TRACE 4,RECINS1   
82TW          LDN   0  A1-3                [TELLS US HOW MANY BACK FROM LAST
83*G          STO   0  ACOMMUNE7(1)        [BLOCK F'BLOCK WILL BE   
83T6          ADX   2  5                   [-> CURRENT RECORD   
84#Q          STO   2  6                   [PRESERVE THIS IN X6 
84SB          LDX   0  AWORK1(1)           [J IF NOT REPLACE
85#2          BPZ   0  NREP5
85RL          LDEX  0  FRH(2)              [SKIP REPLACEE   
86?=          ADX   2  0                   [MOVE ON POINTER TO BLOCK
86QW    NREP5   
87=G          BXGE  4  7,MOVEALL           [J IF WHOLE OF REST OF BLOCK GOES
87Q6          LDN   1  0
889Q    ZLOOP                              [INTO INSERT2 BLOCK  
88PB    #SKI  K6INSERT>299-299  
8992          TRACE 4,FINDMEAN  
89NL          LDEX  0  FRH(2)              [NEXT RECORD 
8=8=          BZE   0  MOVENON             [J IF NONE OF THIS BLOCK GOES INTO   
8=MW                                       [INSERT2 BLOCK   
8?7G          ADX   2  0                   [UPDATE POINTER  
8?M6          ADX   4  0                   [UPDATE "SIZE TO BE LEFT IN INSERT1  
8#6Q          BXL   4  7,ZLOOP             [BLOCK"UNTIL IT EXCEEDS THE AVERAGE  
8#LB          BXL   4  BSBS,MOVESOME       [IN X7,BUT DOWNDATE AGAIN IF LAST RH 
8*62          SBX   2  0                   [PUSHED TOTAL OVER 512   
8*KL          SBX   4  0                   [DOWNDATE 2 TOTALS   
8B5=    MOVEALL                            [=MOVESOME   
8BJW    MOVESOME
8C4G    #SKI  K6INSERT>199$199  
8CJ6          TRACE 4,RESTIN2   
8D3Q    #SKI  K6INSERT  
8DHB    (   
8F32          LDEX  0  FRH(2)              [J IF NO OVERFLOW.   
8FGL          BZE   0  ZGEOER2  
8G2=    )   
8GFW          LDX   1  FX2  
8G^G          LDX   3  ACOMMUNE2(1)        [-> INSERT2  
8HF6          LDX   1  AWORK3(1)
8HYQ          ANDN  1  -1   
8JDB          SBX   1  2                   [SUB PTR TO START OF AREA TO BE  
8JY2          SMO      FX2                 [MOVED,AND ADD PTR TO INSERT1 BLOCK. 
8KCL          ADX   1  ACOMMUNE3           [GIVES SIZE TO BE MOVED  
8KX=    #SKI  K6INSERT  
8LBW    (   
8LWG          BXGE  1  BSBS,ZGEOER6 
8MB6          BZE   1  ZGEOER6  
8MTQ    )   
8N*B          ADN   3  A1   
8NT2    #SKI  K6INSERT>199$199  
8P#L          TRACE 1,FROM1TO2  
8PS=          MOVE  2  1(1)                [MOVE AREA ACROSS.   
8Q?W    #   
8QRG    #     WE NOW MOVE DOWN THE INSERT1 BLOCK & MOVE IN THE NEW RECORD   
8R?6    #   
8RQQ    MOVENON 
8S=B          LDX   0  2                   [GIVES SIZE TO BE MOVED DOWN 
8SQ2          SBX   0  6
8T9L          LDX   2  FX2  
8TP=          STO   1  ACOMMUNE4(2)        [STORE   
8W8W          LDX   3  6                   [PTR TO START OF AREA IN INSERT1 
8WNG          LDEX  1  AWORK1(2)           [SIZE OF FXTRA REQUIRED  
8X86          BZE   0  QCHRDPT             [J IF NOTHING TO BE MOVED DOWN   
8XMQ          CALL  7  MOVEDOWNB           [MOVE BLOCK DOWN.
8Y7B          BRN      RDPTCH   
8YM2    QCHRDPT 
8^6L          SMO   1   
8^L=          STOZ  0(3)                   [ZEROISE LAST WORD   
925W    RDPTCH  
92KG          LDX   1  ACOMMUNE3(2)        [-> INSERT1  
9356          STO   1  ACOMMUNE8(2) 
93JQ          LDX   0  AWORK1(2)           [J IF REPLACE,NO NEED
944B          BNG   0  NOCHRDPT            [TO CHANGE READ POINTERS 
94J2          ANDN  0  #777                [BOTTOM 9 BITS = SIZE OF INSERTEE
953L          SMO      ACOMMUNE5(2)        [-> FCA  
95H=          ADS   0  FREADWORD
962W    NOCHRDPT
96GG          MHUNTW   2,FILE,FWB   
9726          ADN   2  A1   
97FQ          LDEX  1  FRH(2)   
97^B    #SKI  K6INSERT>199-199  
98F2          TRACE   1,MOVEFWB2
98YL          MOVE  2  0(1)                [MOVE IN NEW RECORD  
99D=    #SKI  K6INSERT>299-299  
99XW          TRACE    0(3),NEW REC 
9=CG    NOWIN1  
9=X6    #   
9?BQ    #     WE NOW MOVE ACROSS A CHUNK FROM THE TOP OF THE INSERT3 BLOCK  
9?WB    #     INTO THE BOTTOM OF THE INSERT2 BLOCK & MOVE UP THE REST OF THE
9#B2    #     INSERT3 BLOCK 
9#TL    #   
9**=          LDX   2  FX2  
9*SW    #SKI  K6INSERT>299-299  
9B#G          TRACE  AWORK4(2),TRY3TO2  
9BS6          LDX   7  ACOMMUNE1(2)        [AVERAGE 
9C?Q          LDX   2  ACOMMUNE5(2)        [X2 -> FCA   
9CRB          CALL  1  SFFURB              [X2 -> INSERT3   
9D?2    #HAL  FI+INSERT3,0  
9DQL          LDX   1  FX2  
9F==          STO   2  ACOMMUNE3(1)        [STORE PTR TO BLOCK  
9FPW          ADN   2  A1   
9G9G          LDX   4  AWORK4(1)           [AMT. USED IN INSERT3
9GP6          SBN   4  A1   
9H8Q          BXGE  7  4,NONEMOVE          [J IF INSERT3 BLOCK OK.  
9HNB          LDX   5  ACOMMUNE4(1)        [AMOUNT ALREADY IN INSERT2 BLOCK 
9J82          BXGE  7  5,YLXP              [IF NOT COMPARATIVELY LARGE JUMP 
9JML          LDX   7  5                   [O/W RECALCULATE AVERAGE BETWEEN 
9K7=          ADX   7  AWORK4(1)           [TWO BLOX.WE'VE DECIDED TO PUT TOO   
9KLW          SRA   7  1                   [MUCH INTO THE I2 BLOCK;WE'LL HAVE TO
9L6G          STO   7  ACOMMUNE1(1)        [MAKE THE BEST OF IT.
9LL6          BXGE  7  4,NONEMOVE          [J AGAIN IF I3 NOW ABOUT RIGHT   
9M5Q    YLXP
9MKB          LDX   1  2                   [PRESERVE
9N52    YLOOP   
9NJL    #SKI  K6INSERT>499-499  
9P4=          TRACE 4,FINDMEAN  
9PHW          LDEX  0  FRH(1)              [NEXT R.H
9Q3G    #SKI  K6INSERT  
9QH6          BZE   0  ZGEOER11            [ENDBLOCK
9R2Q          ADX   5  0                   [ADD ON R.H.TO TOTAL INTO I2 BLOCK.  
9RGB          BXL   5  BSBS,NEXLOOP        [J IF NOT YET EXCEEDED GSBS. 
9S22          SBX   5  0                   [AS WE CAN ONLY PUT 511 WORDS
9SFL          BRN      YLPEND   
9S^=    NEXLOOP 
9TDW          SBX   4  0                   [DECREMENT     TO BE LEFT IN BLOCK   
9TYG          ADX   1  0                   [UPDATE PTR  
9WD6          BXL   7  4,YLOOP         [J BACK IF AMOUNT NOT YET ENOUGH.
9WXQ    YLPEND  
9XCB    #SKI  K6INSERT>299-299  
9XX2          TRACE  4,TO MOVE. 
9YBL          SMO      FX2  
9YW=          SBX   5  ACOMMUNE4           [AMOUNT TO BE MOVED FROM I3 TOI2 
9^*W    #SKI  K6INSERT>199-199  
9^TG          TRACE  5,FROM3TO2 
=2*6          BZE   5  NONEMOVE            [J IF MOVE NONE I3->I2   
=2SQ          BXE   4  7,UNCLEVER          [IF EQUAL,NO NEED TO BE CLEVER   
=3#B          BRN      YCLEVER             [SOMETHING INGENIOUS MAY BE DONE.
=3S2    SUBLASTRH   
=4?L    #SKI  K6INSERT>699-699  
=4R=          TRACE    0,-LAST  
=5=W          ADX   4  0                   [IF OVERFLOW CALCULATED WON'T FIT,   
=5QG          SBX   5  0                   [PUT LAST RECORD BACK INTO INSERT3.  
=6=6          BZE   5  NONEMOVE            [J IF NONE LEFT  
=6PQ          SBX   1  0
=79B          BRN      UNCLEVER 
=7P2    YCLEVER 
=88L    #SKI  K6INSERT>699-699  
=8N=          TRACE    5,YCLEVER
=97W          LDX   3  0                   [SAVE
=9MG          SRA   3  1                   [TAKE 1/2 LAST R.H, & ADD TO TOTAL TO
==76          ADX   3  4                   [BE LEFT IN INSERT3 IF THIS IS   
==LQ          BXGE  7  3,SUBLASTRH         [NO!LESS THAN AVGE,SUB LAST R.H. 
=?6B    UNCLEVER
=?L2    #SKI  K6INSERT>299-299  
=#5L    (   
=#K=          TRACE    4,UNCLEVER   
=*4W          TRACE    5,ACROSS 
=*JG    )   
=B46          SMO      FX2  
=BHQ          LDX   3  ACOMMUNE2           [-> INSERT2  
=C3B          SMO      FX2  
=CH2          ADX   3  ACOMMUNE4           [ADD AMOUNT ALREADY MOVED IN 
=D2L          ADN   3  A1   
=DG=          SMO      5
=D^W          MOVE  2  0                   [MOVE ACROSS 
=FFG          SMO      5                   [AMOUNT MOVED IN 
=F^6          STOZ     0(3)                [ZEROISE LAST WORD IN BLOCK  
=GDQ          SMO      4                   [AMOUNT LEFT;
=GYB          MOVE  1  1                   [MOVE UP BLOCK +1 FOR ZERO WORD  
=HD2          SMO      FX2  
=HXL          ADS   5  ACOMMUNE4
=JC=    NONEMOVE
=JWW          LDX   2  FX2                 [RENAME INSERT2 BLOCK.   
=KBG          LDX   1  ACOMMUNE2(2) 
=KW6          LDX   2  ACOMMUNE5(2) 
=L*Q          LDX   6  FREADBLOCK(2)
=LTB          PSTAC  2,2
=M*2          BFCBX  2,2                   [-> FCB  
=MSL          SBX   6  FBLMOD(2)           [IF LAST BLOCK HAS BEEN A^TERED  
=N#=          SMO   FX2                    [DECREMEND CMOD  
=NRW          SBX   6  ACOMMUNE7
=P?G          BNZ   6  NOTLASTALT   
=PR6          ADN   4  A1   
=Q=Q          STO   4  CMOD(2)  
=QQB          NGS   4  CMOD(2)             [UNTIL I CAN W_K OUT WHAT TO DO  
=R=2    NOTLASTALT  
=RPL          SMO      FX2  
=S9=          LDX   0  ACOMMUNE4
=SNW    #SKI  K6INSERT>199$199  
=T8G          TRACE  0,TOTALIN2 
=TN6          BXGE   0 BSBS,ZGEOER7 
=W7Q          LDX   7  FBLMOD(2)
=WMB          SBN   7  FBLKS-A1-FNEARLY 
=X72          SBX   7  FSIZE(2) 
=XLL          SETREP    OK  
=Y6=          BNG   7   NSETFRP            [J IF NOT NEARLY FULL
=YKW          SETREP    FNEARLY 
=^5G    NSETFRP 
=^K6          LDN   0  #77  
?24Q          ANDX  0  FINFC(2) 
?2JB          BZE   0  RENAMEW             [J IF NOT INDEXED
?342          ACROSS   INDEX,3  
?3HL    RENAMEW 
?43=          LDX   2  FX2  
?4GW          LDX   1  ACOMMUNE2(2) 
?52G          NAME  1,FILE,FUWB 
?5G6          LDX   1  ACOMMUNE3(2) 
?5^Q          NAME  1,FILE,FUWB 
?6FB          LDX   1  ACOMMUNE8(2) 
?6^2          NAME  1,FILE,FUWB 
?7DL          UP
?7Y=    #   
?8CW    #     HERE WE  HAVE TO MOVE A "SANDWICH" ACROSS FROM THE INSERT1 TO THE 
?8XG    #     INSERT2 BLOCK.IT CONSISTS OF A SMALL AMOUNT OF OVERFLOW BEFORE
?9C6    #     FREADWORD;THEN THE NEW RECORD;THEN THE REST OF THE INSERT1 BLOCK. 
?9WQ    #     WE BRANCH BACK TO"NOCHRDPT" TO DEAL WITH THE INSERT3 BLOCK.   
?=BB    RECINS2 
?=W2    #SKI  K6INSERT>199-199  
??*L          TRACE  4,RECINS2  
??T=          LDCT  0  #20                 [SET RINB FOR INDEXING   
?##W          ORS   0  AWORK1(1)
?#SG          LDN   0  A1-2                [TELLS US HOW MANY BACK FROM LAST
?*#6          STO   0  ACOMMUNE7(1)        [BLOCK F'BLOCK WILL POINT
?*RQ          LDX   3  ACOMMUNE2(1) 
?B?B          ADN   3  A1                  [-> INSERT2 BLOCK
?BR2          LDX   0  AWORK3(1)
?C=L          ANDN  0  -1   
?CQ=          BXL   0  7,POSSTOPINS       [J IF POSS TO MOVE SOME FROM INSERT1  
?D9W    NOTOPINS
?DPG          LDX   2  ACOMMUNE3(1) 
?F96          SMO      ACOMMUNE5(1) 
?FNQ          ADX   2  FREADWORD
?G8B          BRN      NOTOPINS3
?GN2    POSSTOPINS  
?H7L          SBN   5  A1   
?HM=          ADN   2  A1   
?J6W          LDN   4  0
?JLG    VLOOP   
?K66    #SKI  K6INSERT>499-499  
?KKQ          TRACE   4,VLOOP   
?L5B          LDEX  0  FRH(2)              [NEXT R.H.   
?LK2    #SKI  K6INSERT  
?M4L          BZE   0  ZGEOER6  
?MJ=          ADX   2  0                   [UPDATE CORE PTR 
?N3W          ADX   4  0                   [UPDATE "SIZE LEFT IN INSERT1 BLOCK" 
?NHG          BXE   4  5,NOTOPINS   
?P36          BXL   4  7,VLOOP             [J BACK IF NOT YET UP TO OPTIMUM.
?PGQ    #SKI  K6INSERT>199-199  
?Q2B          TRACE  4,SIZEINS1 
?QG2          ADN   4  A1   
?Q^L          SMO      ACOMMUNE5(1)        [J IF NEXT RECORD IS THE REPLACEE OR 
?RF=          SBX   4  FREADWORD           [POST-INSERTEE.(NO TOP TO "SANDWICH" 
?RYW          BZE   4  QREPL1   
?SDG          BPZ   4  NOTOPINS2           [BEING MOVED INTO THE INSERT2 BLOCK) 
?SY6          NGX   4  4
?TCQ          SMO   4   
?TXB          MOVE  2  0                   [MOVE TOP IN 
?WC2    #SKI  K6INSERT>199$199  
?WWL          TRACE  4,TOPINS1  
?XB=          SMO   4                      [PICK UP R.H.OF NEXT RECORD  
?XTW          LDEX  6  FRH(2)   
?Y*G          STOZ  0(2)
?YT6          ADX   3  4                   [UPDATE PTR  
?^#Q          BRN      YTOPINS2 
?^SB    NOTOPINS2   
#2#2          SBX   2  0                   [DECREMENT POINTER   
#2RL    NOTOPINS3   
#3?=          LDN   4  0
#3QW    QREPL1  
#4=G          LDEX  6  FRH(2)              [R.H.OF REPLACEE OR POST-INSERTEE
#4Q6    YTOPINS2
#59Q    #SKI  K6INSERT>199$199  
#5PB          TRACE  4,TOP1->2  
#692          STO   4  ACOMMUNE4(1)        [STORE   
#6NL          MHUNTW  2,FILE,FWB            [NEW RECORD 
#78=          ADN   2  A1   
#7MW          SMO      FRH(2)   
#87G          MOVE  2  0               [MOVE IT IN  
#8M6          SMO      FRH(2)   
#96Q          STOZ  0(3)                   [ZERO WORD   
#9LB          LDEX  4  FRH(2)   
#=62          ADS   4  ACOMMUNE4(1)        [UPDATE"AREA MOVED INTO INSERT2 BLOCK
#=KL          LDX   2  ACOMMUNE3(1)        [-> INSERT1  
#?5=          STO   2  ACOMMUNE8(1)        [FOR END 
#?JW          SMO      ACOMMUNE5(1)        [-> FCA  
##4G          ADX   2  FREADWORD           [-> RECORD   
##J6          LDX   0  AWORK1(1)              [MARKER WORD  
#*3Q          BPZ   0  NREP6               [J IF INSERT 
#*HB          STOZ     0(2)                [ZEROISE LAST WOID IN INSERT1 BLOCK  
#B32          ADX   2  6                   [J OWER RECORD   
#BGL          LDX   0  3
#C2=          SBX   0  ACOMMUNE2(1)        [PTR TO INSERT2 BLOCK.   
#CFW          SMO      ACOMMUNE5(1)        [-> FCA  
#C^G          STO   0  FREADWORD           [NEW FREADWORD   
#DF6          BRN      YREP4
#DYQ    NREP6   
#FDB          LDX   0  ACOMMUNE4(1)        [AMOUNT IN INSERT2 BLOCK 
#FY2          ADN   0  A1                  [+A1 
#GCL          SMO      ACOMMUNE5(1)        [->FCA   
#GX=          STO   0  FREADWORD           [NEW FREADWORD   
#HBW    YREP4   
#HWG          ADX   3  4                   [ZERO WD. @ END OF BLOCK 
#JB6          STOZ     0(3) 
#JTQ          LDN   0  1
#K*B          SMO      ACOMMUNE5(1)        [->FCA   
#KT2          ADS   0  FREADBLOCK          [+1 TO F'BLOCK   
#L#L          LDX   0  AWORK3(1)           [AMOUNT USED IN INSERT1 BLOCK
#LS=          ANDN  0  -1   
#M?W          SBX   0  2                   [PTR TO START OF AREA TO BE MOVED AC/
#MRG          ADX   0  ACOMMUNE3(1)        [ROSS AS BOTTOM OF SANDWICH,+ PTR TO 
#N?6                                       [INSERT1 BL. TO ABSOLUTIZE.  
#NQQ          BZE   0  NOBOTINS2           [X0 CONTAINS SIZE OF BOTTOM OF "SAND/
#P=B                                       [WICH".J IF NOUGHT.  
#PQ2          SMO      0                   [MOVE IT ACROSS  
#Q9L          MOVE  2  1                   [+ZERO  WORD 
#QP=    #SKI  K6INSERT>199$199  
#R8W          TRACE  0,BOTINS1  
#RNG          ADS   0  ACOMMUNE4(1)        [UPDATE "SIZE MOVED INTO INSERT2 BL."
#S86    NOBOTINS2   
#SMQ          STOZ  0(2)                   [END OF BLOCK
#T7B          BRN      NOWIN1              [GO TO DO INSERT3 -> INSERT2 
#TM2    SHAR3BAK
#W6L          BRN      ZGEOER1  
#WL=    [   
#X5W          MENDAREA K6INSERT/5<100>30,K99INSERTHR
#XKG    #END
^^^^ ...15744606000700000000